packages feed

shake 0.3 → 0.19.9

raw patch · 222 files changed

Files

+ CHANGES.txt view
@@ -0,0 +1,792 @@+Changelog for Shake (* = breaking change)++0.19.9, released 2026-01-19+    Test with GHC 9.12, improving some errors+0.19.8, released 2024-01-14+    Test with GHC 9.8+    #844, optimise database reading/writing with use unsafeUseAsCString+    #836, add threaded flag to disable using threaded runtime+    #837, require filepath-1.14+0.19.7, released 2022-09-15+    #815, improve corrupt database handling code+    Don't say (changed) for files that don't build+0.19.6, released 2021-09-07+    #810, don't hash files in &%> if you don't have to+0.19.5, released 2021-07-04+    #807, fix space leak in Database module+    #796, fix a bug with newCache dependencies+    #798, optimise dependency checking+0.19.4, released 2021-01-14+    #790, add option shakeAllowRedefineRules+*   #790, remove overrideBuiltinRule+0.19.3, released 2021-01-14+    #789, add overrideBuiltinRule+    #787, more documentation on doesFileExist+0.19.2, released 2020-11-15+    #780, Autodeps should consider a rename as a write to the destination+    #778, AutoDeps shouldn't trigger for files read and written+    #779, merge dependencies in O(n and a bit)+    #779, merge local traces in O(n)+    #768, the embed-files flag work on the executable too+0.19.1, released 2020-06-06+    #757, make sure shared cache writes are atomic+    Remove a small space leak if using the Database module+    #755, add instance IsCmdArgument (NonEmpty String)+    #754, tighten bounds to exclude GHC 7.10+0.19, released 2020-05-23+    #738, improve the help text+    #679, allow Ninja to depend on a directory+*   #748, close stdin by default in cmd+    #748, add NoProcessGroup and InheritStdin to cmd+    Delete stuff deprecated since 2014 - **>, ?>>, *>>, *>, |*>, &*>+    Mark askOracleWith and deprioritize as DEPRECATED+    #753, fix timing information for batch+    #746, optimise file modification times on Linux+    #746, add an instance for CmdArgument ()+    Allow getting FSATrace ByteString as a result+*   Make the FSATrace type polymorphic over the FilePath+    Speed up FSATrace parsing+    Require extra-1.6.19+0.18.5, released 2020-02-02+    Use uninterruptibleMask_ to ensure all cleanup happens robustly+    #742, make the Chrome profile only include the last run+    #740, make CmdArgument an instance of IsCmdArgument+0.18.4, released 2019-12-15+    #734, add Forward.cacheActionWith+    #734, make forward fail if shakeLintInside is empty+*   #701, make shakeSymlink=False the default+    #694, embed data files in the binary (use embed-files Cabal flag)+    #722, don't close file handles in cmd unless CloseFileHandles+    #727, add actionBracket for bracket-like operations+    #720, add --share-sanity to sanity check shared cache contents+    #719, write history key after cached files to ensure it is coherent+    #703, print rebuild warnings in yellow and errors in red+    #706, rename Verbosity's constructors and add Warn+    #443, add getEnvError+    #662, add Partial to command/cmd+    #708, rename deprioritize to reschedule+    #689, allow adding help messages at the end using addHelpSuffix+    #686, rename Build.hs to Shakefile.hs+    #690, make Ninja mode use -j0 by default (more like Ninja)+0.18.3, released 2019-07-01+    Add shakeSymlink to enable/disable symlinks in the shared cache+    Improve cmd on async exceptions with nested processes on Windows+0.18.2, released 2019-05-19+    #678, fix serious bug in writeFileChanged+0.18.1, released 2019-05-19+    #678, fix serious bug in writeFile', deleting the wrong file+0.18, released 2019-05-14+*   Make files copied to the shared cache read-only+    Delete files before writing, giving symlink/readonly safety+    #677, make --help work even if the build system throws errors+*   Use parallelism for Applicative adjacent needs+    Support GHC 8.8+0.17.9, released 2019-05-01+    #675, allow --compact=yes|no|auto+    Make lintTrackAllow work after the lintTrackRead/Write+*   Merge successive Cwd declarations to cmd+    #671, change the file format to permit rsync of caches+    Speed up lint tracking+    #670, make cloud values more portable between machines+    #666, exceptions in --share-list, --share-remove are warnings+0.17.8, released 2019-04-02+    Eliminate a corner case of losing exception messages+    Make FSATrace available as a result type+    Commands which have AutoDeps aren't also linted+    #278, add StdoutTrim - like Stdout, but with trim applied+    #659, require base >= 4.8+0.17.7, released 2019-03-18+    Add back -B as an alias for --rebuild+    Make --help say which other options have changed+    Add --lint-ignore flag to set shakeLintIgnore+    Improve the documentation for produces, call trackWrite+    Make trackWrite/trackRead respect shakeLintIgnore+    Make --lint-fsatrace also add to shakeLintInside+    #656, make --lint-fsatrace work with relative directories+    Make sure --no-build does not destroy previous profile output+    #437, #414, #298 rewrite the profile view+    #588, #521 add end times and traced top-levels to the profile+    Add askOracles+    Generate nested dependency information in profiles+    Don't add .exe add the end of traced cmd calls+    Change the profiling .json format+    #651, remove support for GHC 7.4, 7.6 and 7.8+0.17.6, released 2019-02-17+    Make --progress on Windows work with non-ASCII characters+    #18, add --compact for a Bazel/Buck style output+    Make the progress message display a more traditional count+    #638, add shakeTrace to record start/stop of traced commands+    Show user-added options separately+    #625, make --help show the list of targets+    #625, add addTarget/getTargets to track the available targets+    #416, generalise Forward.cacheAction to be in label and output+    #642, detect files that change with --lint-watch+    #649, add --share-list and --share-remove to work with the cache+    #626, improve the display of error messages with call stacks+    Make sure exceptions don't change based on verbosity setting+    Make sure all thread pool threads terminate before shake returns+    #646, change the identity property to require a Maybe+    Use symlinks for --shared+    #643, add MonadFail Rules+0.17.5, released 2019-02-05+    Remove dependency on heaps+0.17.4, released 2019-01-10+    Add shakeProfileDatabase to generate profile information+    Don't suggest -qb (irrelevant with -qg)+0.17.3, released 2018-12-04+    #632, remove O(n^2) behaviour when constructing user rules+    In diagnostic mode, show the number of actions/rules/user rules+0.17.2, released 2018-11-29+    Make needHasChanged work even between runs+0.17.1, released 2018-11-14+    Add actionCatch, to catch exceptions in Action+    #622, avoid potential maxBound overflow in batch+    Reduce the context required for addBuiltinRule+0.17, released 2018-10-15+    Add Database module for repeated execution from one database+*   Don't export the body of the Typeable type class+    Mark deprecated operators as DEPRECATED+    Improve async exception safety in some corner cases+    Support shakeFiles=/dev/null to avoid any database+    Add reprioritise to change the priority of a running rule+    Add a dependency on heaps package+    #611, fix a race condition in actionFinally that reran handlers+    Remove a potential space leak in the Rules monad+    #412, clarify that removeFilesAfter should be used sparingly+    #409, improve the documentation of newCache+    Generalise operations like versioned to Rules a -> Rules a+    Make the Shake database version string contain os and arch+    Don't delete the whole database when an oracle disappears+    #300, soften the database version change message+    IMPORTANT: Incompatible on disk format change+    #590, print "Build completed" timing with better accuracy+    #581, improve the information and display of call stacks+    Add actionRetry to retry actions if they fail+    #143, give locations when several rules match+    Compatibility with unix-2.8+    Add shakeShare, --share and history functions for shared builds+    #574, extensive documentation of Development.Shake.Rule+*   Change how alternative and priority rules interact+    Add versioned for rules+*   Change all the ways of obtaining user rules, see getUserRuleOne+    Improve time recording for unsafeExtraThread, parallel, batch+    #553, improve file-hash performance when nothing changes+*   Require addBuiltinRule to take a BuiltinIdentity argument+*   Make the third argument to BuiltinRun a real ADT+    Disable all the lintTrack functions unless lint is enabled+*   Change the Development.Shake.Rule.track* functions to lintTrack*+    #584, add Semigroup/Monoid instances for Action+    Add produces to declare which untracked files a rule produces+    Add historyDisable to note which rules cannot be cached+    #583, add replaceDirectory1+    Add addOracleHash for oracles with reduced storage requirements+0.16.4, released 2018-04-04+    #185, add addOracleCache which doesn't always rerun+    #576, remove incorrect Cabal description+    #575, print --help message at Quiet verbosity or above+0.16.3, released 2018-02-23+    Allow reading data files from next to the executable+    #566, require extra-1.6.1+    #565, deal with multi-file rules that don't create their contents+    Improve the documentation of getDirectoryContents+0.16.2, released 2018-02-13+    Set the correct lower bound on unordered-containers of 0.2.7+0.16.1, released 2018-02-11+    Support process-1.6.3.0+    #290, add withTempFileInside and withTempDirInside+    #549, Semigroup-Monoid proposal support+    Hadrian-462, fail gracefully if on-disk formats change+    #469, only print timing information at normal verbosity or above+    #340, add runAfter+    #372, deprecate askOracleWith+    #520, only record each dependency once+    #548, rebuild the Ninja files, if they change, restart+    #547, make Ninja --lint checking see through phonys+    #546, support Ninja line continuations in more places+    #470, make --verbose and --quiet help text clearer+    #534, make writeFile' and writeFileChanged create the directory+    #543, add resultHasChanged to track results which have changed+    Add getShakeExtraRules, like getShakeOptionsRules for shakeExtra+    #535, add shakeArgsOptionsWith to manipulate ShakeOptions+    #538, make sure processes can be killed properly+    #502, add needHasChanged to track what in a need has changed+    Weaken the typeclasses required for apply/apply1+    #502, add batch function to batch commands with high startup+    Avoid parallel duplicating local state such as discounting+    Prefer to resume tasks rather than start new ones+0.16, released 2017-09-20+    #536, make --skip work for oracles+    Ensure shakeOutput is used more consistently+    #49, add shakeColor and --color flags+    #490, recommend -threaded as standard+    #517, ignore ./ in FilePattern+    Require extra-1.5.3+    #499, add a filePattern function, like ?== but with the matches+    #474, never spawn user actions unmasked+    Allow user arguments to replace builtin arguments+    #522, make copyFile create directories if necessary+    #516, add an example for withTempDir+    #514, expose more about cmd arguments+    #523, #524, make sure phony doesn't run its dependencies first+    #515, add cmd_ function+    #506, allow duplicate type names in different modules+    #503, require shakeExtra to obey the sensible invariants+    #503, add getShakeExtra/addShakeExtra+    #492, fix the single letter flag documentation+    Expose 'Process' from Development.Shake+    #495, remove dangling link from LICENSE+    #436, remove Assume, switch to Rebuild+    Remove --always-make, use --rebuild instead+    #419, remove --assume-old and --assume-new, which never worked+    Remove support for running Makefile scripts+    Add getShakeOptionsRules, to get ShakeOptions in Rules+    #479, improve the robustness of the Pool tests+    #481, document how to raise errors in Action+    Delete the deprecated system* functions+    #427, check stored value after checking dependencies+    Significant changes to defining custom rules+    Delete the deprecated defaultRule+    IMPORTANT: Incompatible on disk format change+    #428, don't persist errors to the database+0.15.11, released 2017-01-18+    #488, make sure parallel tracks dependencies+    #513, permit process-1.4.3.0 and above+0.15.10, released 2016-06-14+    #465, fix phony names which clash with directories+0.15.9, released 2016-06-12+    Documentation tweaks+    Optimise the thread pool+    Fix progress output through wget+0.15.8, released 2016-06-01+    Extra base bounds to rule out building on GHC 7.4+0.15.7, released 2016-06-01+    Require extra-1.4.8+    #457, better error message when calling need on a directory+    #456, use displayException for inner exceptions+    Improve the documentation for priority/alternative+    #448, fix FSATrace on Mac 10.11+    #444, optimise copyFileChanged+    #58, change writeFile functions to MonadIO+0.15.6, released 2016-04-19+    Require the primitive package+    #431, make it an error to need a directory+    #393, add orderOnlyAction, a general version of orderOnly+    #408, explain that alwaysRerun has no immediate effect+    #410, add --digest-not flag to select ChangeModtime+    #416, export ShakeValue from the main module only+    #352, improve the grammar in the profiling document+    #399, explain what in getDirectoryFiles is tracked+    #108, add getDirectoryFilesIO, an untracked version+    #401, document getDirectoryFiles exception behaviour+    #401, fix getDirectoryFiles error on pattern directory missing+    #400, detect indirect recursion in build rules+    #402, give better errors on recursive rules+    #369, clarify the docs for putQuiet/putLoud+    #405, make sure phony targets with \ work on Windows+    Require extra-1.4.3+    #398, only require old-time with GHC 7.4+    #239, make Rules an instance of MonadIO+    #384, add shakeExtra field to ShakeOptions for user data+    #374, make --debug=file write out newlines+    #308, make sure Shell and AutoDeps work together+    #365, fix unicode output with putNormal+    #269, add parallel execution via parallel/forP/par+    #310, preserve quoting around cmd+    #333, optimise the random pool, up to 20% faster+    #335, add deriving Read instances for more types+    Add Development.Shake.Forward for forward-defined systems+    #336, export :->+    #337, fix the docs for &%>+    #297, make <enter> run the query profile viewer+    #305, make profiling work with newer Chrome+    #327, Add AutoDeps feature+    #325, add FileStdin to specify the stdin comes from a file+    Make an empty Stdin different from no Stdin (inherit) in cmd+    #320, add ** as a relative-only alternative to // in patterns+    #283, change the semantics of removeFiles, no implicit deletes+    #283, speed up getDirectoryFiles on patterns involving literals+    Work with stack test+    Add RemEnv cmd option+    Fix a small space leak on Linux+    Fix a space leak in profile summary information+    Properly handle *//* in file pattern (at least one directory)+    #303, allow ninja rule names to have dots in them+    Properly handle /// in file pattern (a wildcard then /)+    Make sure Windows separators work in |%> FilePattern rules+    #296, fix multifile rules when using --digest-and-input+    #286, document the relationship between getEnv and lookupEnv+    #285, improve the documentation for phony/alwaysRerun+    #284, fix the documentation for normaliseEx+    #293, add getProgress+    #270, support MonadFix for Rules, allows recursive cache+    #295, discount time spent waiting for a cache+    #294, give better error messages if you hit GHC bug #10793+    #4, add a lock file to stop corrupting databases+0.15.5, released 2015-08-04+    #279, make usingConfigFile do a need on the config file+    Fix a bug where predicted progress could sometimes be ??+    #264, make the the suite more less non-deterministic+0.15.4, released 2015-06-20+    Undo a locally modified file+0.15.3, released 2015-06-20+    #254, in staunch mode, print out all exceptions+    Require extra-1.3+    #259, discount time waiting for a resource in profiles+    #252, have the docs test configure not in dist+0.15.2, released 2015-05-22+    #248, add another example of using cmd+    #245, initial support for fsatrace lint checking+    Reexport -<.> from filepath where available+    Hoogle #106, trigger on filepath version, not GHC version+    Add AddEnv and AddPath command options+    #243, close fds in child processes when spawning commands+    Make Ninja variable handling more accurate+0.15.1, released 2015-04-25+    If you have Shakefile.hs, pass it all arguments without interp+    Add shakeArgsPrune and shakeArgsPruneWith+    #228, allow running cmd async by collecting the ProcessHandle+    Make getShakeOptions/processorCount of 0 return the used value+    #212, document how to get a full terminal with cmd+    #225, warn if there are no want/action statements+    #232, don't ignore phony order-only dependencies in Ninja+    #226, add escaping for GraphViz labels+    #227, add StdinBS for passing a bytestring as Stdin+    Make cmd Timeout call terminateProcess as well+0.15, released 2015-03-26+    #203, make shakeFiles a directory rather than a file prefix+    #220, add getHashedShakeVersion helper+    #220, add shakeVersionIgnore to ignore version numbers+    #219, run Shakefile.hs from the shake binary+    #218, fix issues with incorrect unchanging with no digests+    #218, fix issue with ChangeModtimeAndDigest on unchanging files+    #216, work around GHC 7.10 RC3 bug 10176+    #213, add phonys, a predicate phony rule+    Add CmdTime and CmdLine results to cmd/command+    Fix parseMakefile for words with multiple escapes in them+    #205, add WithStdout, like WithStderr+    #27, add support for capturing Stdout/Stderr with bytestrings+    Add FileStdout/FileStderr to write a stream direct to a file+    #211, add Stdouterr to capture both Stdout and Stderr streams+    Require extra-1.1 (to use nubOrd)+    Generalise cmd to work with Maybe [String]+    Add unit for use with cmd+    IMPORTANT: Incompatible on disk format change+    #209, improve orderOnly dependencies+0.14.3, released 2015-01-07+    Support for the filepath shipped with GHC 7.10+    Add Timeout option to command+0.14.2, released 2014-11-27+    #198, add <//> operator to join FilePatterns+    #198, fix the <.> and other extension methods to work with //+0.14.1, released 2014-11-21+    #196, change the links to point at http://www.shakebuild.com/+    Improve the error messages when &%> or &?> go wrong+    Normalise file patterns used by &?>+0.14, released 2014-11-19+    Make FilePattern on Windows cope with all path separators+    Rename normalise to normaliseEx+    Expose native System.FilePath in Development.Shake.FilePath+    #193, eliminate the custom version of </>+    #193, make need/orderOnly call normalise on their arguments+    #177, use the $PATH variable to resolve cmd+    #182, use js-jquery and js-flot+    #195, add getConfigKeys+    #194, replace *> with %> as the operator for rules+    #188, improve the docs on FilePattern+    #187, removeFiles on a missing directory should do nothing+    #166, add withTempFile and withTempDir in the Action monad+    Ensure Ninja response files are always deleted+    Fix incorrect units when showing profile to the console+    Require the extra library+    #178, make --help show the current executable name+0.13.4, released 2014-09-19+    #171, fix the --demo mode on Linux+0.13.3, released 2014-09-16+    Ensure you wait until the progress thread cleans up+    Add --demo mode+    Add --progress=record and --progress=replay+    Add -j to run with one thread per processor+    Fix progress reporting to work even on the first run+    Apply abbreviations to staunch failure messages+    Fix failure progress messages during staunch mode+    #165, make |*> matching with simple files much faster+    Add toStandard to the FilePath module+    #130, support msvc_deps_prefix in Ninja+    #157, allow variable substitution in include/subninja statements+    #147, add the version in the profile reports+    #147, add --numeric-version flag+    #28, switch to continuation passing style, uses far less threads+    #156, add readConfigFileWithEnv for configs with an initial env+    #129, fix processor count detection on Mac with -threaded+    #155, add --live and shakeLiveFiles+    #153, handle escaped spaces in parseMakefile+    #152, fix typo in the manual+    Add copyFileChanged+    Fix the leaf column in profile reports+    Add Maybe instances for cmd arguments+    Add a --profile flag (alias for --report)+    Switch to an underlying continuation monad+0.13.2, released 2014-06-20+    #95, ensure progress never gets corrupted+    #124, add a profile report demo+    #128, allow long Ninja command lines+    Fix --report=- for builds with no commands in them+0.13.1, released 2014-05-28+    Remove all package upper bounds+    #126, Ninja compatibility if Ninja fails to create a file+    #123, generate Chrome compatible traces+0.13, released 2014-05-27+    #122, make --report=- write a report to stdout+    Improve the profile report summary+    #122, turn shakeReport into a list of files, instead of a Maybe+    #60, improve how command lines are printed out+    #113, print info about copyFile' and removeFilesAfter at -V+    Replace **> with |*> , ?>> with &?> and *>> with &*>+    IMPORTANT: Incompatible on disk format change+    #83, support digest rules for files+    #83, add shakeChange parameter and --digest* args+    #83, add equalValue function to Rule typeclass+    Deprecate defaultRule+    Make literal *> matches take precedence over wildcard matches+    #120, add a priority function+0.12, released 2014-05-09+    #62, move to a ReaderT/IORef for the Action monad+    Add DEPRECATED pragmas on system' calls+    Delete Development.Shake.Sys, use command or cmd instead+    Add a 'console' pool to Ninja+    Avoid using System.Cmd (deprecated in GHC HEAD)+    #41, use higher precision file times on POSIX+    #117, use higher precision times for Unicode files on Windows+    #118, add support for Ninja -t compdb+    #119, more test fixes for Linux GHC 7.8+0.11.7, released 2014-05-05+    #119, test fixes for Linux GHC 7.8+0.11.6, released 2014-05-04+    #114, run build.sh in the test suite with sh+    #115, fix the test suite on Linux GHC 7.8+    #116, fix for GHC 7.10+0.11.5, released 2014-04-25+    Include the sources for flot and jQuery in the dist tarball+    Note that .. in FilePattern values is unlikely to be correct+    #109, make removeFiles delete directories that match+    #84, make removeFiles not delete empty unmatched directories+    #111, fixes to the user manual+    #110, don't give a warning if -threaded is turned off+    #103, don't suggest -qg and -qb, they fail without -threaded+    #102, fix up </> when the LHS starts with .+0.11.4, released 2014-03-20+    Work with QuickCheck-2.7 (which defines ===)+    #100, handle GraphViz missing gracefully+    Fix up the profiling report generation+    #99, add getEnvWithDefault+0.11.3, released 2014-02-27+    #97, fix a serialisation bug when > 254 arguments to need+0.11.2, released 2014-02-18+    #96, fix a bug in addPath that caused $PATH to be added twice+0.11.1, released 2014-02-06+    #94, GHC 7.8 support+    Add a Config module+    #89, support :: as a build rule separator+0.11, released 2014-01-03+    Add alternatives to allow overlapping rules+    Make storedValue take a ShakeOptions structure+    Generalise the newCache function+    Improve the performance of the Ninja parser+    Make the database more compact+    #84, ensure you normalise removeFile patterns first+    #82, make -j0 guess at the number of processors+    #81, add --lint-tracker to use tracker.exe+    Add trackRead, trackWrite+    Add trackUse, trackChange, trackAllow+    #85, move rule creation functions into Development.Shake.Rule+    Mark Development.Shake.Sys as DEPRECATED with a pragma+    Change shakeLint to be of type Maybe Lint, instead of Bool+    #50, add shakeArgsAccumulate+0.10.10, released 2013-11-16+    Improve Ninja --lint checking+0.10.9, released 2013-11-15+    #76, add Ninja specific lint checking+    #75, add orderOnly dependencies+    #76, add needed, to assert a need doesn't rebuild+    #78, don't use cabal in the test suite+    #77, add shakeRunCommands and --skip-commands+    #67, add withVerbosity+    #51, add getShakeOptions+    Lots of Haddock improvements+    Deprecate system', use cmd or command instead+    #53, add addPath and addEnv to modify environment variables+    Make all search path things return the native separators+    #73, if Haskell can't write a unicode filename, skip the test+    Print out the entire database in diagnostics mode+    Rewrite database writes, old code could break metadata on error+    #25, optimise building with Ninja+    Fix many bugs in FilePath.normalise+    Require QuickCheck-2.0 or higher+    Change how the makefile parser treats \ characters+    Add a --no-build flag+    #74, allow cmd to be used with result IO+    Add a Util module, with Makefile parsing+0.10.8, released 2013-10-15+    Allow unix-1.5.1 again+    Require Cabal 1.10 or above+    Convert to the cabal test compatible test suite+0.10.7, released 2013-09-26+    Support time-1.2+    #71, fix a bug when requesting all three outputs from command+    #64, add progressProgram and use it in progressSimple+    Remove isRunning, kill the progress thread on completion+    #47, improve the performance of ?==, especially on "//*"+    #68, improve the docs for addOracle+    #55, ensure if you need phony targets you rebuild every time+    #52, ensure all command output is printed+    #20, document preferred compilation flags+    #20, speed up the Shake executable with GHC RTS flags+    #39, print out more of the version string on database change+    #41, require unix-2.6 or above+    #48, make it clear filetimes are hashes+    #43, improve the error messages on lint failures+    #45, avoid use of nub+    #45, avoid use of intersect which is O(n^2)+    #26, add newThrottle to create throttling resources+    #26, add unsafeExtraThread to run more than shakeThreads+    #32, add a check that withResources does not call need+    #614, support unicode filenames+    Require unordered-containers-0.2.1 or above+    Reduce stack usage when lint checking+    #24, create the output directories for the multiple file rule+    Improvements to match Ninja behaviour+0.10.6, released 2013-06-28+    Include command/cmd in the default module+    #16, change the scoping in subninja+    #15, fix up the Ninja default targets+    Fix up --version output+0.10.5, released 2013-06-14+    Improve progress prediction for the first build+    Fix removeFiles when there is a directory argument and a pattern+    Delete shakeDeterministic, shakeThreads=1 has the same effect+0.10.4, released 2013-06-13+    Fix writeFileChanged for line endings on Windows+    Support arguments to --progress+    Set the number of capabilities based on -j flags+    Add shakeTimings, to time the separate stages+    Add AssumeSkip, mostly for benchmarking+    Normalise file arguments before calling want+    Expose ShakeException+    Add isFailure to ShakeProgress, and display in progressDisplay+    Add withResources+    Add -<.> alias for replaceExtension+    Add selectors on Stdout/Stdin/Exit+    Add CmdResult instance for ExitCode+0.10.3, released 2013-05-12+    Upgrade to Flot-0.8+    Small documentation markup fixes+0.10.2, released 2013-03-30+    Require process-1.1 or above+    Improve progress guesses (use exponential decay of work rate)+    Improve profiling report error messages+    Add a Command module, with alternatives to system' etc.+    #593, don't assume doesDirectoryExist = not . doesFileExist+    #594, swap how traced messages are printed out+    Add Chatty verbosity, for what was Loud+    Make repeated --verbose keep increasing the verbosity+    If shakeThreads==1 then always use a deterministic pool+    Add shakeLineBuffering, defaulting to True+    Improve the performance of profiling+    Documentation and corrections improvements+    Eliminate StepKey from the profiling output+    Add a --no-time flag+    Makefile improvements+    Avoid use of ghc-options in .cabal file+0.10.1, released 2013-03-18+    Allow the shake executable to build+0.10, released 2013-03-17+    Add phony, for writing phony actions+    Add removeFilesAfter+    Switch to the new profiling code+    Add actionOnException and actionFinally+    Add shakeArgsWith+    Rename shakeWithArgs to shakeArgs and change the clean argument+    Remove the -f alias for --flush+    Add a shake executable which runs Makefiles+    Rename shake to shake-test+    Change how progress messages are written+    Do not write a beep in progressDisplay, avoids a beep+    Add exe function to FilePath+0.9.1, released 2013-02-28+    GHC head (7.7) compatibility by removing the Rules fundep+0.9, released 2013-02-16+    Make the tests work on Linux+    Fix report generation on machines whose text format is not ASCII+    Make Directory functions work the same on Linux/Mac+    Change shakeVersion to be a String+    Stop alwaysRerun causing lint failures+    Make shakeLint check that the current directory does not change+    Add shakeOutput setting+    Add removeFiles function+    Add Sys module for writing consise system calls+    Add getEnv function+    Add shakeWithArgs and shakeOptDescrs+    Add newCache to cache the parsed contents of files+    Add newResourceIO and move newResource into the Rules monad+    Add shakeStorageLog, to help diagnosing obscure database errors+0.8, released 2013-01-31+    Improve the Oracle documentation+    Allow getDirectoryFiles to operate recursively+0.7, released 2013-01-29+    Change getDirectoryFiles to take a set of file patterns+    Add doesDirectoryExist function+    Add shakeAbbreviations feature+    Add a new Progress module for sensible progress messages+    Spawn shakeProgress on a separate thread, a safer default+    Improve the runtime error messages+    Add a quietly function, to hide traced commands+    Print main status messages when running a traced command+    Display the exit code when a system command fails+    Fix AssumeClean when the result exists but has never been built+    IMPORTANT: Incompatible on disk format change+    Change the storage to not write messages on --silent+    Add Applicative on Rules+    Add Applicative on Action+0.6, released 2013-01-09+    Make addOracle return a result of askOracle+    Export the class bodies from Classes+    Don't export ShakeValue from Classes+0.5, released 2013-01-05+    IMPORTANT: Incompatible on disk format change+    Add the ShakeValue constraint synonym+    Change the Oracle to be strongly typed+    Add a Classes module+0.4, released 2013-01-02+    Add shakeFlush to control how often flush is called+    Fix a serious space leak in the thread pool+    #502, add shakeAssume to assume files are clean/dirty+    Remove validStored, replace with storedValue+    Remove the default validStored class, almost never right+    Remove Eq/Ord from ShakeOptions (now contains a func)+    #501, add statistics gathering functions to help report progress+    Ensure registering witnesses is thread safe+    Ensure GHC does not over-optimise type registration+0.3.10, released 2012-12-17+    Add Paths.hs so you can run the tests from the tarball+0.3.9, released 2012-12-17+    Don't rely on toList returning a consistent order+    Allow hashable-1.2+0.3.8, released 2012-12-12+    Fix up FilePattern so "foo//bar" ?== "foo/bar"+0.3.7, released 2012-12-02+    Update the cabal file+0.3.6, released 2012-11-27+    Add addOracles, for implementing more advanced oracles+    Add withoutActions, for implementing command line arguments+0.3.5, released 2012-11-27+    #571, vastly improve the correctness of FilePattern+    #574, documentation typos+    Expose rulePriority+0.3.4, released 2012-09-17+    Update documentation with links to ICFP 2012 paper/talk+0.3.3, released 2012-09-17+    Minor refactorings+0.3.2, released 2012-09-12+    Fix cabal specification on non-Windows+0.3.1, released 2012-09-08+    Don't use syntax also stolen by QuasiQuotes+    Avoid warnings about unused monadic values+    Fix up getModificationTime for GHC 7.6+    Don't assume catch is exported by Prelude (GHC 7.6 compat)+    Improve the error message when failing to build with *>> or ?>>+    Introduce a portable flag, to switch to portable FileTime ops+    Improve the error message when failing to build a file+    Ensure errors raised bubble up quickly+    Significant improvements to the profile output+    Only trace the program name by default, not the entire command+    Allow unordered-containers < 0.2 again+    Intern all keys, so they are only stored once+    Optimise modification time checking on Unix+    Optimise modification time checking on Windows+    Make some fields smaller on disk+    IMPORTANT: Incompatible on disk format change+    Switch to ByteString for storing File+    Add shakeDeterministic, along with a default random pool+    Make the Monad/Monoid instance for Rules strict+0.3, released 2012-06-17+    #550, ensure the journal thread is locked+    #550, if your thread dies while reading the database then die+    #550, ensure you reset to before the slop before writing+    If the witness table is completely corrupt give a better error+    Make storage work with exceptions whose messages raise errors+    Journal error conditions, to ensure they don't repeat+    Better messages on invalid database versions+    Complete rewrite of the storage layer and journal design+    IMPORTANT: Incompatible on disk format change+0.2.11, released 2012-05-19+    IMPORTANT: #546, don't save the database to where it was created+0.2.10, released 2012-05-19+    Add systemCwd for running with a particular current directory+    Ensure the database is saved to where it was created+    #545, make sure if shake is killed, it kills its children+0.2.9, released 2012-03-25+    Require unordered-containers 2.1 or higher, fixes bugs+    Allow transformers-0.3.*+    Add a random script generator and tester+    Improve the documentation for withResource+    Fix the unordered-containers constraint, was too loose+    Don't write report generation messages in Quiet mode+    Add ?>> operator, a generalisation of *>>+0.2.8, released 2012-02-24+    Rename shakeDump to shakeReport+    Add profile report generator+0.2.7, released 2012-02-18+    #530, require unordered-containers >= 0.1.4.3+0.2.6, released 2012-02-17+    Improve the documentation code fragments (more links)+    Add support for managing finite resources+0.2.5, released 2012-02-15+    Require hashable-1.1.2.3, which has a TypeRep instance+    Add Data/Typeable instances for ShakeOptions+    Add Data instance for Verbosity+0.2.4, released 2012-02-11+    Include the C example source files+    Significant documentation improvements+0.2.3, released 2012-02-09+    Create the shakeFiles directory if missing+0.2.2, released 2012-02-05+    Allow deepseq-1.3.*+    Add a basic lint checking mode+    Remove the Dirty state entirely (was incorrect)+0.2.1, released 2012-01-28+    Put diagnostics in more places+    Add a C example+0.2, released 2012-01-23+    Add shakeStaunch+    Rename shakeParallel to shakeThreads+    Delete the lint support (never actually worked)+    Completely rewrite the central build algorithm+    Add verbosity Diagnostic+    Improve FilePath.normalise+    Add writeFileChanged+    Add systemOutput+    Add an Oracle module+    Add an explicit Verbosity type+    Change to lower precedence for *> etc+0.1.5, released 2012-01-01+    Allow deepseq-1.2+0.1.4, released 2012-01-01+    Don't export currentRule/currentStack+    Fix **>, was matching the wrong way round+    Fix FilePath normalise so it works properly on Windows+    Properly detect recursive rules, instead of looping+    Add *>> for building multiple files at once+0.1.3, released 2011-12-22+    Fix a bug where a file rule could return with a lazy error+    Make sure all the files are stored in binary, not text+    Fix a pattern match error in getDirectoryFiles+0.1.2, released 2011-12-18+    Add a warning in the description+0.1.1, released 2011-12-18+    Significantly improved documentation+    system' now takes an initial argument for the program+0.1, released 2011-12-18+    Many changes to signatures, some basic documentation+    Additional demo, to build shake itself+0.0, released 2011-12-11+    Initial version, not ready for public use
− Development/Shake.hs
@@ -1,110 +0,0 @@---- | This module is used for defining Shake build systems. As a simple example of a Shake build system,---   let us build the file @result.tar@ from the files listed by @result.txt@:------ @---import "Development.Shake"---import "Development.Shake.FilePath"------main = 'shake' 'shakeOptions' $ do---    'want' [\"result.tar\"]---    \"*.tar\" '*>' \\out -> do---        contents <- 'readFileLines' $ 'Development.Shake.FilePath.replaceExtension' out \"txt\"---        'need' contents---        'system'' \"tar\" $ [\"-cf\",out] ++ contents--- @------   We start by importing the modules defining both Shake and routines for manipulating 'FilePath' values.---   We define @main@ to call 'shake' with the default 'shakeOptions'. As the second argument to---   'shake', we provide a set of rules. There are two common forms of rules, 'want' to specify target files,---   and '*>' to define a rule which builds a 'FilePattern'. We use 'want' to require that after the build---   completes the file @result.tar@ should be ready.------   The @*.tar@ rule describes how to build files with the extension @.tar@, including @result.tar@.---   We 'readFileLines' on @result.txt@, after changing the @.tar@ extension to @.txt@. We read each line---   into the variable @contents@ -- being a list of the files that should go into @result.tar@. Next, we---   depend ('need') all the files in @contents@. If any of these files change, the rule will be repeated.---   Finally we call the @tar@ program. If either @result.txt@ changes, or any of the files listed by @result.txt@---   change, then @result.tar@ will be rebuilt.------   When writing a Shake build system, start by defining what you 'want', then write rules---   with '*>' to produce the results. Before calling 'system'' you should ensure that any files the command---   requires are demanded with calls to 'need'. We offer the following advice to Shake users:------ * If @ghc --make@ or @cabal@ is capable of building your project, use that instead. Custom build systems are---   necessary for many complex projects, but many projects are not complex.------ * The CmdArgs package (<http://hackage.haskell.org/package/cmdargs/>) is well suited to providing---   command line parsing for build systems, often using flags to set fields in 'shakeOptions'.------ * Put all result files in a distinguished directory, for example @_make@. You can implement a @clean@---   command by removing that directory, using 'removeDirectoryRecursive'.------ * To obtain paralell builds set 'shakeThreads' to a number greater than 1. You may also need to---   compile with @-threaded@.------ * Often the 'want' commands will be determined by command line arguments, to mirror the behaviour of @make@---   targets.------ * Lots of compilers produce @.o@ files. To avoid overlapping rules, use @.c.o@ for C compilers,---   @.hs.o@ for Haskell compilers etc.------ * Do not be afraid to mix Shake rules, system commands and other Haskell libraries -- use each for what---   it does best.------ * The more accurate the dependencies are, the better. Use additional rules like 'doesFileExist' and---   'getDirectoryFiles' to track information other than just the contents of files. For information in the environment---   that you suspect will change regularly (perhaps @ghc@ version number), either write the information to---   a file with 'alwaysRerun' and 'writeFileChanged', or use 'addOracle'.------   The theory behind an old version of Shake is described in a video at <http://vimeo.com/15465133>.------   /Acknowledgements/: Thanks to Austin Seipp for properly integrating the profiling code.-module Development.Shake(-    shake,-    -- * Core of Shake-    ShakeOptions(..), shakeOptions,-    Rule(..), Rules, defaultRule, rule, action,-    Action, apply, apply1, traced,-    Verbosity(..), getVerbosity, putLoud, putNormal, putQuiet,-    liftIO,-    -- * Utility functions-    module Development.Shake.Derived,-    -- * File rules-    need, want, (*>), (**>), (?>),-    module Development.Shake.Files,-    FilePattern, (?==),-    -- * Directory rules-    doesFileExist, getDirectoryContents, getDirectoryFiles, getDirectoryDirs,-    -- * Additional rules-    addOracle, askOracle,-    alwaysRerun,-    -- * Finite resources-    Resource, newResource, withResource-    ) where---- I would love to use module export in the above export list, but alas Haddock--- then shows all the things that are hidden in the docs, which is terrible.--import Control.Monad.IO.Class-import Development.Shake.Core-import Development.Shake.Derived--import Development.Shake.Directory-import Development.Shake.File-import Development.Shake.FilePattern-import Development.Shake.Files-import Development.Shake.Oracle-import Development.Shake.Rerun----- | 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.-shake :: ShakeOptions -> Rules () -> IO ()-shake opts r = do-    run opts $ do-        r-        defaultRuleFile-        defaultRuleDirectory-        defaultRuleRerun-    return ()
− Development/Shake/Binary.hs
@@ -1,25 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}--module Development.Shake.Binary(-    BinaryWith(..), module Data.Binary-    ) where--import Control.Monad-import Data.Binary--class BinaryWith ctx a where-    putWith :: ctx -> a -> Put-    getWith :: ctx -> Get a--instance (BinaryWith ctx a, BinaryWith ctx b) => BinaryWith ctx (a,b) where-    putWith ctx (a,b) = putWith ctx a >> putWith ctx b-    getWith ctx = do a <- getWith ctx; b <- getWith ctx; return (a,b)--instance BinaryWith ctx a => BinaryWith ctx [a] where-    putWith ctx xs = put (length xs) >> mapM_ (putWith ctx) xs-    getWith ctx = do n <- get; replicateM n $ getWith ctx--instance BinaryWith ctx a => BinaryWith ctx (Maybe a) where-    putWith ctx Nothing = putWord8 0-    putWith ctx (Just x) = putWord8 1 >> putWith ctx x-    getWith ctx = do i <- getWord8; if i == 0 then return Nothing else fmap Just $ getWith ctx
− Development/Shake/Core.hs
@@ -1,401 +0,0 @@-{-# LANGUAGE RecordWildCards, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}-{-# LANGUAGE ExistentialQuantification, MultiParamTypeClasses, FunctionalDependencies #-}--module Development.Shake.Core(-    ShakeOptions(..), shakeOptions, run,-    Rule(..), Rules, defaultRule, rule, action,-    Action, apply, apply1, traced,-    Verbosity(..), getVerbosity, putLoud, putNormal, putQuiet,-    Resource, newResource, withResource-    ) where--import Prelude hiding (catch)-import Control.DeepSeq-import Control.Exception-import Control.Monad-import Control.Monad.IO.Class-import Control.Monad.Trans.State-import Data.Binary(Binary)-import Data.Data-import Data.Hashable-import Data.Function-import Data.List-import qualified Data.HashMap.Strict as Map-import Data.Maybe-import Data.Monoid--import Development.Shake.Pool-import Development.Shake.Database-import Development.Shake.Locks-import Development.Shake.Value-import Development.Shake.Report-------------------------------------------------------------------------- OPTIONS---- | Options to control the execution of Shake, usually specified by overriding fields in---   'shakeOptions':------   @ 'shakeOptions'{'shakeThreads'=4, 'shakeReport'=Just \"report.html\"} @-data ShakeOptions = ShakeOptions-    {shakeFiles :: FilePath -- ^ Where shall I store the database and journal files (defaults to @.shake@).-    ,shakeThreads :: Int -- ^ What is the maximum number of rules I should run in parallel (defaults to @1@).-                         --   To enable parallelism you may need to compile with @-threaded@.-    ,shakeVersion :: Int -- ^ What is the version of your build system, increment to force a complete rebuild (defaults to @1@).-    ,shakeVerbosity :: Verbosity -- ^ What messages to print out (defaults to 'Normal').-    ,shakeStaunch :: Bool -- ^ Operate in staunch mode, where building continues even after errors (defaults to 'False').-    ,shakeReport :: Maybe FilePath -- ^ Produce an HTML profiling report (defaults to 'Nothing').-    ,shakeLint :: Bool -- ^ Perform basic sanity checks after building (defaults to 'False').-    }-    deriving (Show,Eq,Ord,Typeable,Data)---- | The default set of 'ShakeOptions'.-shakeOptions :: ShakeOptions-shakeOptions = ShakeOptions ".shake" 1 1 Normal False Nothing False----- | All forseen exception conditions thrown by Shake, such problems with the rules or errors when executing---   rules, will be raised using this exception type.-data ShakeException = ShakeException-        [String] -- Entries on the stack, starting at the top of the stack.-        SomeException -- Inner exception that was raised.-        -- If I make these Haddock comments, then Haddock dies-    deriving Typeable--instance Exception ShakeException--instance Show ShakeException where-    show (ShakeException stack inner) = unlines $-        "Error when running Shake build system:" :-        map ("* " ++) stack ++-        [show inner]----- | The verbosity data type, used by 'shakeVerbosity'.-data Verbosity-    = Silent -- ^ Don't print any messages.-    | Quiet  -- ^ Only print essential messages (typically errors).-    | Normal -- ^ Print normal messages (typically errors and warnings).-    | Loud   -- ^ Print lots of messages (typically errors, warnings and status updates).-    | Diagnostic -- ^ Print messages for virtually everything (for debugging a build system).-      deriving (Eq,Ord,Bounded,Enum,Show,Read,Typeable,Data)--------------------------------------------------------------------------- RULES---- | Define a pair of types that can be used by Shake rules.-class (-    Show key, Typeable key, Eq key, Hashable key, Binary key, NFData key,-    Show value, Typeable value, Eq value, Hashable value, Binary value, NFData value-    ) => Rule key value | key -> value where--    -- | Given that the database contains @key@/@value@, does that still match the on-disk contents?-    ---    --   As an example for filenames/timestamps, if the file exists and had the same timestamp, you-    --   would return 'True', but otherwise return 'False'. For rule values which are not also stored-    --   on disk, 'validStored' should always return 'True'.-    validStored :: key -> value -> IO Bool-    validStored _ _ = return True--{--    -- | Return 'True' if the value should not be changed by the build system. Defaults to returning-    --   'False'. Only used when running with 'shakeLint'.-    invariant :: key -> Bool-    invariant _ = False--    -- | Given an action, return what has changed, along with what you think should-    --   have stayed the same. Only used when running with 'shakeLint'.-    observed :: IO a -> IO (Observed key, a)-    observed = fmap ((,) mempty)----- | Determine what was observed to change. For each field @Nothing@ means you don't know anything, while---   @Just []@ means you know that nothing was changed/used.-data Observed a = Observed-    {changed :: Maybe [a] -- ^ A list of keys which had their value altered.-    ,used :: Maybe [a] -- ^ A list of keys whose value was used.-    }-    deriving (Show,Eq,Ord)--instance Functor Observed where-    fmap f (Observed a b) = Observed (g a) (g b)-        where g = fmap (map f)--instance Monoid (Observed a) where-    mempty = Observed Nothing Nothing-    mappend (Observed x1 y1) (Observed x2 y2) = Observed (f x1 x2) (f y1 y2)-        where-            f Nothing Nothing = Nothing-            f a b = Just $ fromMaybe [] a ++ fromMaybe [] b--}---data ARule = forall key value . Rule key value => ARule (key -> Maybe (Action value))--ruleKey :: Rule key value => (key -> Maybe (Action value)) -> key-ruleKey = undefined--ruleValue :: Rule key value => (key -> Maybe (Action value)) -> value-ruleValue = undefined--ruleStored :: Rule key value => (key -> Maybe (Action value)) -> (key -> value -> IO Bool)-ruleStored _ = validStored----- | Define a set of rules. Rules can be created with calls to 'rule', 'defaultRule' or 'action'. Rules are combined---   with either the 'Monoid' instance, or (more commonly) the 'Monad' instance and @do@ notation.-data Rules a = Rules-    {value :: a -- not really used, other than for the Monad instance-    ,actions :: [Action ()]-    ,rules :: Map.HashMap TypeRep{-k-} (TypeRep{-k-},TypeRep{-v-},[(Int,ARule)]) -- higher fst is higher priority-    }--instance Monoid a => Monoid (Rules a) where-    mempty = return mempty-    mappend a b = (a >> b){value = value a `mappend` value b}--instance Monad Rules where-    return x = Rules x [] (Map.fromList [])-    Rules v1 x1 x2 >>= f = Rules v2 (x1++y1) (Map.unionWith g x2 y2)-        where Rules v2 y1 y2 = f v1-              g (k, v1, xs) (_, v2, ys)-                | v1 == v2 = (k, v1, xs ++ ys)-                | otherwise = error $ "There are two incompatible rules for " ++ show k ++ ", producing " ++ show v1 ++ " and " ++ show v2--instance Functor Rules where-    fmap f x = return . f =<< x----- | Like 'rule', but lower priority, if no 'rule' exists then 'defaultRule' is checked.---   All default rules must be disjoint.-defaultRule :: Rule key value => (key -> Maybe (Action value)) -> Rules ()-defaultRule = ruleWith 0----- | Add a rule to build a key, returning an appropriate 'Action'. All rules must be disjoint.---   To define lower priority rules use 'defaultRule'.-rule :: Rule key value => (key -> Maybe (Action value)) -> Rules ()-rule = ruleWith 1----- | Add a rule at a given priority.-ruleWith :: Rule key value => Int -> (key -> Maybe (Action value)) -> Rules ()-ruleWith i r = mempty{rules = Map.singleton k (k, v, [(i,ARule r)])}-    where k = typeOf $ ruleKey r; v = typeOf $ ruleValue r----- | Run an action, usually used for specifying top-level requirements.-action :: Action a -> Rules ()-action a = mempty{actions=[a >> return ()]}--------------------------------------------------------------------------- MAKE--data S = S-    -- global constants-    {database :: Database-    ,pool :: Pool-    ,started :: IO Time-    ,stored :: Key -> Value -> IO Bool-    ,execute :: Key -> Action Value-    ,output :: String -> IO ()-    ,verbosity :: Verbosity-    ,logger :: String -> IO ()-    -- stack variables-    ,stack :: [Key] -- in reverse-    -- local variables-    ,depends :: [[Key]] -- built up in reverse-    ,discount :: Duration-    ,traces :: [(String, Time, Time)] -- in reverse-    }---- | The 'Action' monad, use 'liftIO' to raise 'IO' actions into it, and 'need' to execute files.---   Action values are used by 'rule' and 'action'.-newtype Action a = Action (StateT S IO a)-    deriving (Functor, Monad, MonadIO)----- | This function is not actually exported, but Haddock is buggy. Please ignore.-run :: ShakeOptions -> Rules () -> IO ()-run opts@ShakeOptions{..} rs = do-    start <- startTime-    registerWitnesses rs--    output <- do-        lock <- newLock-        return $ withLock lock . putStrLn--    let logger = if shakeVerbosity >= Diagnostic then output . ("% "++) else const $ return ()--    except <- newVar (Nothing :: Maybe SomeException)-    let staunch act | not shakeStaunch = act >> return ()-                    | otherwise = do-            res <- try act-            case res of-                Left err -> do-                    modifyVar_ except $ \v -> return $ Just $ fromMaybe err v-                    let msg = show err ++ "Continuing due to staunch mode, this error will be repeated later"-                    when (shakeVerbosity >= Quiet) $ output msg-                Right _ -> return ()--    let stored = createStored rs-    let execute = createExecute rs-    withDatabase logger shakeFiles shakeVersion $ \database -> do-        runPool shakeThreads $ \pool -> do-            let s0 = S database pool start stored execute output shakeVerbosity logger [] [] 0 []-            mapM_ (addPool pool . staunch . wrapStack [] . runAction s0) (actions rs)-        when shakeLint $ do-            checkValid database stored-            when (shakeVerbosity >= Loud) $ output "Lint checking succeeded"-        when (isJust shakeReport) $ do-            let file = fromJust shakeReport-            json <- showJSON database-            when (shakeVerbosity >= Normal) $-                putStrLn $ "Writing HTML report to " ++ file-            buildReport json file-    maybe (return ()) throwIO =<< readVar except---wrapStack :: [Key] -> IO a -> IO a-wrapStack stk act = catch act $ \(SomeException e) -> case cast e of-    Just s@ShakeException{} -> throw s-    Nothing -> throw $ ShakeException (map show stk) $ SomeException e---registerWitnesses :: Rules () -> IO ()-registerWitnesses Rules{..} =-    forM_ (Map.elems rules) $ \(_, _, (_,ARule r):_) -> do-        registerWitness $ ruleKey r-        registerWitness $ ruleValue r---createStored :: Rules () -> (Key -> Value -> IO Bool)-createStored Rules{..} = \k v ->-    let (tk,tv) = (typeKey k, typeValue v) in-    case Map.lookup tk mp of-        Nothing -> error $-            "Error: couldn't find instance Rule " ++ show tk ++ " " ++ show tv ++-            ", perhaps you are missing a call to defaultRule/rule?"-        Just (tv2,_) | tv2 /= tv -> error $-            "Error: couldn't find instance Rule " ++ show tk ++ " " ++ show tv ++-            ", but did find an instance Rule " ++ show tk ++ " " ++ show tv2 ++-            ", perhaps you have the types wrong in your call to apply?"-        Just (_, r) -> r k v-    where-        mp = flip Map.map rules $ \(k,v,(_,ARule r):_) -> (v, \kx vx -> ruleStored r (fromKey kx) (fromValue vx))---createExecute :: Rules () -> (Key -> Action Value)-createExecute Rules{..} = \k ->-    let tk = typeKey k in-    case Map.lookup tk mp of-        Nothing -> error $-            "Error: couldn't find any rules to build " ++ show k ++ " of type " ++ show tk ++-            ", perhaps you are missing a call to defaultRule/rule?"-        Just rs -> case filter (not . null) $ map (mapMaybe ($ k)) rs of-           [r]:_ -> r-           rs ->-              let s = if null rs then "no" else show (length $ head rs)-              in error $ "Error: " ++ s ++ " rules match for Rule " ++ show k ++ " of type " ++ show tk-    where-        mp = flip Map.map rules $ \(_,_,rs) -> sets [(i, \k -> fmap (fmap newValue) $ r (fromKey k)) | (i,ARule r) <- rs]--        sets :: Ord a => [(a, b)] -> [[b]]-        sets = map (map snd) . reverse . groupBy ((==) `on` fst) . sortBy (compare `on` fst)---runAction :: S -> Action a -> IO (a, S)-runAction s (Action x) = runStateT x s----- | Execute a rule, returning the associated values. If possible, the rules will be run in parallel.---   This function requires that appropriate rules have been added with 'rule' or 'defaultRule'.-apply :: Rule key value => [key] -> Action [value]-apply ks = fmap (map fromValue) $ applyKeyValue $ map newKey ks--applyKeyValue :: [Key] -> Action [Value]-applyKeyValue ks = Action $ do-    modify $ \s -> s{depends=ks:depends s}-    s <- get-    let bad = stack s `intersect` ks-    unless (null bad) $ -        error $ "Invalid rules, recursion detected when trying to build: " ++ show (head bad)-    let exec more_stack k = let stack2 = k : more_stack ++ stack s in try $ wrapStack (reverse stack2) $ do-            evaluate $ rnf k-            let s2 = s{depends=[], stack=stack2, discount=0, traces=[]}-            (dur,(res,s2)) <- duration $ runAction s2 $ do-                putNormal $ "# " ++ show k-                execute s k-            let ans = (res, reverse $ depends s2, dur - discount s2, reverse $ traces s2)-            evaluate $ rnf ans-            return ans-    res <- liftIO $ build (pool s) (database s) (Ops (stored s) exec) ks-    case res of-        Left err -> throw err-        Right (d, vs) -> do-            modify $ \s -> s{discount=discount s + d}-            return vs----- | Apply a single rule, equivalent to calling 'apply' with a singleton list. Where possible,---   use 'apply' to allow parallelism.-apply1 :: Rule key value => key -> Action value-apply1 = fmap head . apply . return----- | Write an action to the trace list, along with the start/end time of running the IO action.---   The 'Develoment.Shake.system'' command automatically calls 'traced'. The trace list is used for profile reports---   (see 'shakeReport').-traced :: String -> IO a -> Action a-traced msg act = Action $ do-    s <- get-    start <- liftIO $ started s-    res <- liftIO act-    stop <- liftIO $ started s-    modify $ \s -> s{traces = (msg,start,stop):traces s}-    return res---putWhen :: (Verbosity -> Bool) -> String -> Action ()-putWhen f msg = Action $ do-    s <- get-    when (f $ verbosity s) $-        liftIO $ output s msg----- | Write a message to the output when the verbosity ('shakeVerbosity') is appropriate.---   The output will not be interleaved with any other Shake messages---   (other than those generated by system commands).-putLoud, putNormal, putQuiet :: String -> Action ()-putLoud = putWhen (>= Loud)-putNormal = putWhen (>= Normal)-putQuiet = putWhen (>= Quiet)----- | Get the current verbosity level, as set by 'shakeVerbosity'. If you---   want to output information to the console, you are recommended to use---   'putLoud' \/ 'putNormal' \/ 'putQuiet', which ensures multiple messages are---   not interleaved.-getVerbosity :: Action Verbosity-getVerbosity = Action $ gets verbosity----- | Run an action which uses part of a finite resource. For an example see 'Resource'.-withResource :: Resource -> Int -> Action a -> Action a-withResource r i act = Action $ do-    s <- get-    (res,s) <- liftIO $ bracket_-        (do res <- acquireResource r i-            case res of-                Nothing -> logger s $ show r ++ " acquired " ++ show i ++ " with no wait"-                Just wait -> do-                    logger s $ show r ++ " waiting to acquire " ++ show i-                    blockPool (pool s) wait-                    logger s $ show r ++ " acquired " ++ show i ++ " after waiting")-        (do releaseResource r i-            logger s $ show r ++ " released " ++ show i)-        (runAction s act)-    put s-    return res
− Development/Shake/Database.hs
@@ -1,350 +0,0 @@-{-# LANGUAGE RecordWildCards, ScopedTypeVariables, PatternGuards #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}--module Development.Shake.Database(-    Time, startTime, Duration, duration, Trace,-    Database, withDatabase,-    Ops(..), build,-    allEntries, showJSON, checkValid,-    ) where--import Development.Shake.Binary-import Development.Shake.Pool-import Development.Shake.Value-import Development.Shake.Locks-import Development.Shake.Storage--import Control.DeepSeq-import Data.Hashable-import Data.Typeable-import Prelude hiding (catch)-import Control.Exception-import Control.Monad-import qualified Data.HashMap.Strict as Map-import Data.IORef-import Data.Maybe-import Data.List-import Data.Time.Clock--type Map = Map.HashMap--------------------------------------------------------------------------- UTILITY TYPES---- FIXME: Binary instance writes out 8 bytes, probably should be 2-newtype Step = Step Int deriving (Eq,Ord,Show,Binary,NFData,Hashable,Typeable)--incStep (Step i) = Step $ i + 1---type Duration = Double -- duration in seconds--duration :: IO a -> IO (Duration, a)-duration act = do-    start <- getCurrentTime-    res <- act-    end <- getCurrentTime-    return (fromRational $ toRational $ end `diffUTCTime` start, res)---type Time = Double -- how far you are through this run, in seconds---- | Call once at the start, then call repeatedly to get Time values out-startTime :: IO (IO Time)-startTime = do-    start <- getCurrentTime-    return $ do-        end <- getCurrentTime-        return $ fromRational $ toRational $ end `diffUTCTime` start--------------------------------------------------------------------------- CENTRAL TYPES--type Trace = (String, Time, Time)----- | Invariant: The database does not have any cycles when a Key depends on itself-data Database = Database-    {lock :: Lock-    ,status :: IORef (Map Key Status)-    ,step :: Step-    ,journal :: Key -> Maybe Result -> IO ()-    ,logger :: String -> IO () -- logging function-    }--data Status-    = Ready Result -- I have a value-    | Error SomeException -- I have been run and raised an error-    | Loaded Result -- Loaded from the database-    | Waiting Pending (Maybe Result) -- Currently checking if I am valid or building-      deriving Show---- FIXME: Probably want Step's to be strict and unpacked? Benchmark on a large example-data Result = Result-    {result :: Value -- the result associated with the Key-    ,built :: Step -- when it was actually run-    ,changed :: Step -- the step for deciding if it's valid-    ,depends :: [[Key]] -- dependencies-    ,execution :: Duration -- how long it took when it was last run (seconds)-    ,traces :: [Trace] -- a trace of the expensive operations (start/end in seconds since beginning of run)-    } deriving Show---newtype Pending = Pending (IORef (IO ()))-    -- you must run this action when you finish, while holding DB lock-    -- after you have set the result to Error or Ready--instance Show Pending where show _ = "Pending"---isError Error{} = True; isError _ = False-isWaiting Waiting{} = True; isWaiting _ = False-isReady Ready{} = True; isReady _ = False----- All the waiting operations are only valid when isWaiting-type Waiting = Status--afterWaiting :: Waiting -> IO () -> IO ()-afterWaiting (Waiting (Pending p) _) act = modifyIORef p (>> act)--newWaiting :: Maybe Result -> IO Waiting-newWaiting r = do ref <- newIORef $ return (); return $ Waiting (Pending ref) r--runWaiting :: Waiting -> IO ()-runWaiting (Waiting (Pending p) _) = join $ readIORef p---- Wait for a set of actions to complete--- If the action returns True, the function will not be called again--- If the first argument is True, the thing is ended-waitFor :: [(a, Waiting)] -> (Bool -> a -> IO Bool) -> IO ()-waitFor ws@(_:_) act = do-    todo <- newIORef $ length ws-    forM_ ws $ \(k,w) -> afterWaiting w $ do-        t <- readIORef todo-        when (t /= 0) $ do-            b <- act (t == 1) k-            writeIORef todo $ if b then 0 else t - 1---getResult :: Status -> Maybe Result-getResult (Ready r) = Just r-getResult (Loaded r) = Just r-getResult (Waiting _ r) = r-getResult _ = Nothing--------------------------------------------------------------------------- OPERATIONS--data Ops = Ops-    {valid :: Key -> Value -> IO Bool-        -- ^ Given a Key and a Value from the database, check it still matches the value stored on disk-    ,exec :: [Key] -> Key -> IO (Either SomeException (Value, [[Key]], Duration, [Trace]))-        -- ^ Given a chunk of stack (bottom element first), and a key, either raise an exception or successfully build it-    }----- | Return either an exception (crash), or (how much time you spent waiting, the value)-build :: Pool -> Database -> Ops -> [Key] -> IO (Either SomeException (Duration,[Value]))-build pool Database{..} Ops{..} ks =-    join $ withLock lock $ do-        vs <- mapM (reduce []) ks-        let errs = [e | Error e <- vs]-        if all isReady vs then-            return $ return $ Right (0, [result r | Ready r <- vs])-         else if not $ null errs then-            return $ return $ Left $ head errs-         else do-            wait <- newBarrier-            waitFor (filter (isWaiting . snd) $ zip ks vs) $ \finish k -> do-                s <- readIORef status-                let done x = do signalBarrier wait x; return True-                case Map.lookup k s of-                    Just (Error e) -> done $ Left e-                    Just Ready{} | finish -> done $ Right [result r | k <- ks, let Ready r = fromJust $ Map.lookup k s]-                                 | otherwise -> return False-            return $ do-                (dur,res) <- duration $ blockPool pool $ waitBarrier wait-                return $ case res of-                    Left e -> Left e-                    Right v -> Right (dur,v)-    where-        k #= v = do-            s <- readIORef status-            writeIORef status $ Map.insert k v s-            let shw = head . words . show-            logger $ maybe "Missing" shw (Map.lookup k s) ++ " -> " ++ shw v ++ ", " ++ show k-            return v--        atom x = let s = show x in if ' ' `elem` s then "(" ++ s ++ ")" else s--        -- Rules for each eval* function-        -- * Must NOT lock-        -- * Must have an equal return to what is stored in the db at that point-        -- * Must not return Loaded--        reduce :: [Key] -> Key -> IO Status-        reduce stack k = do-            s <- readIORef status-            case Map.lookup k s of-                Nothing -> run stack k Nothing-                Just (Loaded r) -> do-                    b <- valid k $ result r-                    logger $ "valid " ++ show b ++ " for " ++ atom k ++ " " ++ atom (result r)-                    if not b then run stack k $ Just r else check stack k r (depends r)-                Just res -> return res--        run :: [Key] -> Key -> Maybe Result -> IO Waiting-        run stack k r = do-            w <- newWaiting r-            addPool pool $ do-                res <- exec stack k-                ans <- withLock lock $ do-                    ans <- k #= case res of-                        Left err -> Error err-                        Right (v,depends,execution,traces) ->-                            let c | Just r <- r, result r == v = changed r-                                  | otherwise = step-                            in Ready Result{result=v,changed=c,built=step,..}-                    runWaiting w-                    return ans-                case ans of-                    Ready r -> do-                        logger $ "result " ++ atom k ++ " = " ++ atom (result r)-                        journal k $ Just r -- leave the DB lock before appending-                    Error _ -> do-                        logger $ "result " ++ atom k ++ " = error"-                        journal k Nothing-                    _ -> return ()-            k #= w--        check :: [Key] -> Key -> Result -> [[Key]] -> IO Status-        check stack k r [] =-            k #= Ready r-        check stack k r (ds:rest) = do-            vs <- mapM (reduce (k:stack)) ds-            let ws = filter (isWaiting . snd) $ zip ds vs-            if any isError vs || any (> built r) [changed | Ready Result{..} <- vs] then-                run stack k $ Just r-             else if null ws then-                check stack k r rest-             else do-                self <- newWaiting $ Just r-                waitFor ws $ \finish d -> do-                    s <- readIORef status-                    let buildIt = do-                            b <- run stack k $ Just r-                            afterWaiting b $ runWaiting self-                            return True-                    case Map.lookup d s of-                        Just Error{} -> buildIt-                        Just (Ready r2)-                            | changed r2 > built r -> buildIt-                            | finish -> do-                                res <- check stack k r rest-                                if not $ isWaiting res-                                    then runWaiting self-                                    else afterWaiting res $ runWaiting self-                                return True-                            | otherwise -> return False-                k #= self--------------------------------------------------------------------------- QUERY DATABASE---- | Return a list of keys in an order which would build them bottom up. Relies on the invariant---   that the database is not cyclic.-allEntries :: Database -> IO [(Key,Value)]-allEntries Database{..} = do-    status <- readIORef status-    return $ ordering [((k, result i), concat $ depends i) | (k,v) <- Map.toList status, Just i <- [getResult v]]-    where-        ordering :: Eq a => [((a,b), [a])] -> [(a,b)]-        ordering xs = f [(a, nub b `intersect` as) | let as = map (fst . fst) xs, (a,b) <- xs]-            where-                f xs | null xs = []-                     | null now = error "Internal invariant broken, database seems to be cyclic (probably during lint)"-                     | otherwise = let ns = map fst now in ns ++ f [(a,b \\ map fst ns) | (a,b) <- later]-                    where (now,later) = partition (null . snd) xs---showJSON :: Database -> IO String-showJSON Database{..} = do-    status <- readIORef status-    let ids = Map.fromList $ zip (Map.keys status) [0..]-        f (k, v) | Just Result{..} <- getResult v =-            let xs = ["name:" ++ show (show k)-                     ,"built:" ++ showStep built-                     ,"changed:" ++ showStep changed-                     ,"depends:" ++ show (mapMaybe (`Map.lookup` ids) (concat depends))-                     ,"execution:" ++ show execution] ++-                     ["traces:[" ++ intercalate "," (map showTrace traces) ++ "]" | traces /= []]-                showStep (Step i) = show i-                showTrace (a,b,c) = "{start:" ++ show b ++ ",stop:" ++ show c ++ ",command:" ++ show a ++ "}"-            in  ["{" ++ intercalate ", " xs ++ "}"]-        f _ = []-    return $ "[" ++ intercalate "\n," (concatMap f $ Map.toList status) ++ "\n]"---checkValid :: Database -> (Key -> Value -> IO Bool) -> IO ()-checkValid Database{..} valid = do-    status <- readIORef status-    logger "Starting validity/lint checking"-    bad <- fmap concat $ forM (Map.toList status) $ \(k,v) -> case v of-        Ready r -> do-            good <- valid k (result r)-            logger $ "Checking if " ++ show k ++ " is " ++ show (result r) ++ ", " ++ if good then "passed" else "FAILED"-            return [show k ++ " is no longer " ++ show (result r) | not good && not (special k)]-        _ -> return []-    if null bad-        then logger "Validity/lint check passed"-        else error $ unlines $ "Error: Dependencies have changed since being built:" : bad--    where-        -- special case for these things, since the purpose is to break the invariant-        special k = s == "AlwaysRun" || "Oracle " `isPrefixOf` s-            where s = show k--------------------------------------------------------------------------- STORAGE---- To simplify journaling etc we smuggle the Step in the database, with a special StepKey-newtype StepKey = StepKey ()-    deriving (Show,Eq,Typeable,Hashable,Binary,NFData)--stepKey :: Key-stepKey = newKey $ StepKey ()--toStepResult :: Step -> Result-toStepResult i = Result (newValue i) i i [] 0 []--fromStepResult :: Result -> Step-fromStepResult = fromValue . result---withDatabase :: (String -> IO ()) -> FilePath -> Int -> (Database -> IO a) -> IO a-withDatabase logger filename version act = do-    registerWitness $ StepKey ()-    registerWitness $ Step 0-    witness <- currentWitness-    withStorage logger filename version witness $ \mp journal -> do-        status <- newIORef $ Map.map Loaded mp-        let step = maybe (Step 1) (incStep . fromStepResult) $ Map.lookup stepKey mp-        journal stepKey $ Just $ toStepResult step-        lock <- newLock-        act Database{..}---instance BinaryWith Witness Step where-    putWith _ x = put x-    getWith _ = get--instance BinaryWith Witness Result where-    putWith ws (Result x1 x2 x3 x4 x5 x6) = putWith ws x1 >> put x2 >> put x3 >> putWith ws x4 >> put x5 >> put x6-    getWith ws = do x1 <- getWith ws; x2 <- get; x3 <- get; x4 <- getWith ws; x5 <- get; x6 <- get; return $ Result x1 x2 x3 x4 x5 x6
− Development/Shake/Derived.hs
@@ -1,92 +0,0 @@--module Development.Shake.Derived where--import Control.Monad-import Control.Monad.IO.Class-import System.Process-import System.Directory-import System.Exit-import qualified Data.ByteString.Char8 as BS--import Development.Shake.Core-import Development.Shake.File-import Development.Shake.FilePath----- | Execute a system command. This function will raise an error if the exit code is non-zero.---   Before running 'system'' make sure you 'need' any required files.-system' :: FilePath -> [String] -> Action ()-system' path args = do-    let path2 = toNative path-    let cmd = unwords $ path2 : args-    putLoud cmd-    res <- traced ("system " ++ cmd) $ rawSystem path2 args-    when (res /= ExitSuccess) $-        error $ "System command failed:\n" ++ cmd----- | Execute a system command with a specified current working directory (first argument).---   This function will raise an error if the exit code is non-zero.---   Before running 'systemCwd' make sure you 'need' any required files.------ > systemCwd "/usr/MyDirectory" "pwd" []-systemCwd :: FilePath -> FilePath -> [String] -> Action ()-systemCwd cwd path args = do-    let path2 = toNative path-    let cmd = unwords $ path2 : args-    putLoud cmd-    res <- traced ("system " ++ cmd) $ do-        -- FIXME: Should I be using the non-exported System.Process.syncProcess?-        --        That installs/removes signal handlers.-        hdl <- runProcess path2 args (Just cwd) Nothing Nothing Nothing Nothing-        waitForProcess hdl-    when (res /= ExitSuccess) $-        error $ "System command failed:\n" ++ cmd----- | Execute a system command, returning @(stdout,stderr)@.---   This function will raise an error if the exit code is non-zero.---   Before running 'systemOutput' make sure you 'need' any required files.-systemOutput :: FilePath -> [String] -> Action (String, String)-systemOutput path args = do-    let path2 = toNative path-    let cmd = unwords $ path2 : args-    putLoud cmd-    (res,stdout,stderr) <- traced ("system' " ++ cmd) $ readProcessWithExitCode path2 args ""-    when (res /= ExitSuccess) $-        error $ "System command failed:\n" ++ cmd ++ "\n" ++ stderr-    return (stdout, stderr)----- | @copyFile old new@ copies the existing file from @old@ to @new@. The @old@ file is has 'need' called on it---   before copying the file.-copyFile' :: FilePath -> FilePath -> Action ()-copyFile' old new = need [old] >> liftIO (copyFile old new)----- | Read a file, after calling 'need'.-readFile' :: FilePath -> Action String-readFile' x = need [x] >> liftIO (readFile x)---- | Write a file, lifted to the 'Action' monad.-writeFile' :: FilePath -> String -> Action ()-writeFile' name x = liftIO $ writeFile name x----- | A version of 'readFile'' which also splits the result into lines.-readFileLines :: FilePath -> Action [String]-readFileLines = fmap lines . readFile'---- | A version of 'writeFile'' which writes out a list of lines.-writeFileLines :: FilePath -> [String] -> Action ()-writeFileLines name = writeFile' name . unlines----- | Write a file, but only if the contents would change.-writeFileChanged :: FilePath -> String -> Action ()-writeFileChanged name x = liftIO $ do-    b <- doesFileExist name-    if not b then writeFile name x else do-        orig <- BS.readFile name-        let new = BS.pack x-        when (orig /= new) $ BS.writeFile name new
− Development/Shake/Directory.hs
@@ -1,116 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving, ScopedTypeVariables, DeriveDataTypeable #-}--module Development.Shake.Directory(-    doesFileExist,-    getDirectoryContents, getDirectoryFiles, getDirectoryDirs,-    defaultRuleDirectory-    ) where--import Control.DeepSeq-import Control.Monad-import Control.Monad.IO.Class-import Data.Binary-import Data.Hashable-import Data.List-import Data.Typeable-import qualified System.Directory as IO--import Development.Shake.Core-import Development.Shake.FilePath-import Development.Shake.FilePattern---newtype Exist = Exist FilePath-    deriving (Typeable,Eq,Hashable,Binary,NFData)--instance Show Exist where-    show (Exist a) = "Exists? " ++ a---data GetDir-    = GetDir {dir :: FilePath}-    | GetDirFiles {dir :: FilePath, pat :: FilePattern}-    | GetDirDirs {dir :: FilePath}-    deriving (Typeable,Eq)-newtype GetDir_ = GetDir_ [FilePath]-    deriving (Typeable,Show,Eq,Hashable,Binary,NFData)--instance Show GetDir where-    show (GetDir x) = "Listing " ++ x-    show (GetDirFiles a b) = "Files " ++ a </> b-    show (GetDirDirs x) = "Dirs " ++ x--instance NFData GetDir where-    rnf (GetDir a) = rnf a-    rnf (GetDirFiles a b) = rnf a `seq` rnf b-    rnf (GetDirDirs a) = rnf a--instance Hashable GetDir where-    hash = hash . f-        where f (GetDir x) = (0 :: Int, x, "")-              f (GetDirFiles x y) = (1, x, y)-              f (GetDirDirs x) = (2, x, "")--instance Binary GetDir where-    get = do-        i <- getWord8-        case i of-            0 -> liftM  GetDir get-            1 -> liftM2 GetDirFiles get get-            2 -> liftM  GetDirDirs get--    put (GetDir x) = putWord8 0 >> put x-    put (GetDirFiles x y) = putWord8 1 >> put x >> put y-    put (GetDirDirs x) = putWord8 2 >> put x---instance Rule Exist Bool where-    validStored (Exist x) b = fmap (== b) $ IO.doesFileExist x-    -- invariant _ = True--instance Rule GetDir GetDir_ where-    validStored x y = fmap (== y) $ getDir x-    -- invariant _ = True----- | This function is not actually exported, but Haddock is buggy. Please ignore.-defaultRuleDirectory :: Rules ()-defaultRuleDirectory = do-    defaultRule $ \(Exist x) -> Just $-        liftIO $ IO.doesFileExist x-    defaultRule $ \(x :: GetDir) -> Just $-        liftIO $ getDir x----- | Returns 'True' if the file exists.-doesFileExist :: FilePath -> Action Bool-doesFileExist = apply1 . Exist---- | Get the contents of a directory. The result will be sorted, and will not contain---   the files @.@ or @..@ (unlike the standard Haskell version). It is usually better to---   call either 'getDirectoryFiles' or 'getDirectoryDirs'. The resulting paths will be relative---   to the first argument.-getDirectoryContents :: FilePath -> Action [FilePath]-getDirectoryContents x = getDirAction $ GetDir x---- | Get the files in a directory that match a particular pattern.---   For the interpretation of the pattern see '?=='.-getDirectoryFiles :: FilePath -> FilePattern -> Action [FilePath]-getDirectoryFiles x f = getDirAction $ GetDirFiles x f---- | Get the directories contained by a directory, does not include @.@ or @..@.-getDirectoryDirs :: FilePath -> Action [FilePath]-getDirectoryDirs x = getDirAction $ GetDirDirs x--getDirAction x = do GetDir_ y <- apply1 x; return y---getDir :: GetDir -> IO GetDir_-getDir x = fmap (GetDir_ . sort) $ f x . filter validName =<< IO.getDirectoryContents (dir x)-    where-        validName = not . all (== '.')--        f GetDir{} xs = return xs-        f GetDirFiles{} xs = flip filterM xs $ \s ->-            if not $ pat x ?== s then return False else IO.doesFileExist $ dir x </> s-        f GetDirDirs{} xs = flip filterM xs $ \s -> IO.doesDirectoryExist $ dir x </> s
− Development/Shake/File.hs
@@ -1,156 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving, DeriveDataTypeable, ScopedTypeVariables #-}--module Development.Shake.File(-    need, want,-    defaultRuleFile,-    (*>), (**>), (?>)-    ) where--import Control.DeepSeq-import Control.Monad.IO.Class-import Data.Binary-import Data.Hashable-import Data.Typeable-import System.Directory--import Development.Shake.Core-import Development.Shake.FilePath-import Development.Shake.FilePattern-import Development.Shake.FileTime--infix 1 *>, ?>, **>---newtype File = File FilePath-    deriving (Typeable,Eq,Hashable,Binary,NFData)--instance Show File where show (File x) = x---instance Rule File FileTime where-    validStored (File x) t = fmap (== Just t) $ getModTimeMaybe x--{--    observed act = do-        src <- getCurrentDirectory-        old <- listDir src-        sleepFileTime-        res <- act-        new <- listDir src-        let obs = compareItems old new-            -- if we didn't find anything used, then most likely we aren't tracking access time close enough-            obs2 = obs{used = if used obs == Just [] then Nothing else (used obs)}-        return (obs2, res)---data Item = ItemDir [(String,Item)] -- sorted-          | ItemFile (Maybe FileTime) (Maybe FileTime) -- mod time, access time-            deriving Show--listDir :: FilePath -> IO Item-listDir root = do-    xs <- getDirectoryContents root-    xs <- return $ sort $ filter (not . all (== '.')) xs-    fmap ItemDir $ forM xs $ \x -> fmap ((,) x) $ do-        let s = root </> x-        b <- doesFileExist s-        if b then listFile s else listDir s--listFile :: FilePath -> IO Item-listFile x = do-    let f x = Control.Exception.catch (fmap Just x) $ \(_ :: SomeException) -> return Nothing-    mod <- f $ getModTime x-    acc <- f $ getAccTime x-    return $ ItemFile mod acc--compareItems :: Item -> Item -> Observed File-compareItems = f ""-    where-        f path (ItemFile mod1 acc1) (ItemFile mod2 acc2) =-            Observed (Just [File path | mod1 /= mod2]) (Just [File path | acc1 /= acc2])-        f path (ItemDir xs) (ItemDir ys) = mconcat $ map g $ zips xs ys-            where g (name, Just x, Just y) = f (path </> name) x y-                  g (name, x, y) = Observed (Just $ concatMap (files path) $ catMaybes [x,y]) Nothing-        f path _ _ = Observed (Just [File path]) Nothing--        files path (ItemDir xs) = concat [files (path </> a) b | (a,b) <- xs]-        files path _ = [File path]--        zips :: Ord a => [(a,b)] -> [(a,b)] -> [(a, Maybe b, Maybe b)]-        zips ((x1,x2):xs) ((y1,y2):ys)-            | x1 == y1  = (x1,Just x2,Just y2):zips xs ys-            | x1 <  y1  = (x1,Just x2,Nothing):zips xs ((y1,y2):ys)-            | otherwise = (y1,Nothing,Just y2):zips ((x1,x2):xs) ys-        zips xs ys = [(a,Just b,Nothing) | (a,b) <- xs] ++ [(a,Nothing,Just b) | (a,b) <- ys]--}----- | This function is not actually exported, but Haddock is buggy. Please ignore.-defaultRuleFile :: Rules ()-defaultRuleFile = defaultRule $ \(File x) -> Just $-    liftIO $ getModTimeError "Error, file does not exist and no rule available:" x----- | Require that the following files are built before continuing. Particularly---   necessary when calling 'Development.Shake.system''. As an example:------ @--- \"//*.rot13\" '*>' \\out -> do---     let src = 'Development.Shake.FilePath.dropExtension' out---     'need' [src]---     'Development.Shake.system'' [\"rot13\",src,\"-o\",out]--- @-need :: [FilePath] -> Action ()-need xs = (apply $ map File xs :: Action [FileTime]) >> return ()---- | Require that the following are built by the rules, used to specify the target.------ @--- main = 'Development.Shake.shake' 'shakeOptions' $ do---    'want' [\"Main.exe\"]---    ...--- @------   This program will build @Main.exe@, given sufficient rules.-want :: [FilePath] -> Rules ()-want xs = action $ need xs----- | Define a rule to build files. If the first argument returns 'True' for a given file,---   the second argument will be used to build it. Usually '*>' is sufficient, but '?>' gives---   additional power. For any file used by the build system, only one rule should return 'True'.------ @--- (all isUpper . 'Development.Shake.FilePath.takeBaseName') '?>' \\out -> do---     let src = 'Development.Shake.FilePath.replaceBaseName' out $ map toLower $ takeBaseName out---     'Development.Shake.writeFile'' . map toUpper =<< 'Development.Shake.readFile'' src--- @-(?>) :: (FilePath -> Bool) -> (FilePath -> Action ()) -> Rules ()-(?>) test act = rule $ \(File x) ->-    if not $ test x then Nothing else Just $ do-        liftIO $ createDirectoryIfMissing True $ takeDirectory x-        act x-        liftIO $ getModTimeError "Error, rule failed to build the file:" x----- | Define a set of patterns, and if any of them match, run the associated rule. See '*>'.-(**>) :: [FilePattern] -> (FilePath -> Action ()) -> Rules ()-(**>) test act = (\x -> any (?== x) test) ?> act---- | Define a rule that matches a 'FilePattern'. No file required by the system must be---   matched by more than one pattern. For the pattern rules, see '?=='.------ @--- \"*.asm.o\" '*>' \\out -> do---     let src = 'Development.Shake.FilePath.dropExtension' out---     'need' [src]---     'Development.Shake.system'' [\"as\",src,\"-o\",out]--- @------   To define a build system for multiple compiled languages, we recommend using @.asm.o@,---   @.cpp.o@, @.hs.o@, to indicate which language produces an object file.---   I.e., the file @foo.cpp@ produces object file @foo.cpp.o@.------   Note that matching is case-sensitive, even on Windows.-(*>) :: FilePattern -> (FilePath -> Action ()) -> Rules ()-(*>) test act = (test ?==) ?> act
− Development/Shake/FilePath.hs
@@ -1,78 +0,0 @@---- | A module for 'FilePath' operations, to be used instead of "System.FilePath"---   when writing build systems. In build systems, when using the file name---   as a key for indexing rules, it is important that two different strings do---   not refer to the same on-disk file. We therefore follow the conventions:------ * Always use @\/@ as the directory separator, even on Windows.------ * When combining 'FilePath' values with '</>' we squash any @\/.\/@ components.-module Development.Shake.FilePath(-    module System.FilePath.Posix,-    dropDirectory1, takeDirectory1, normalise,-    toNative, (</>), combine,-    ) where--import System.FilePath.Posix hiding (normalise, (</>), combine)-import qualified System.FilePath as Native-import Data.List----- | Drop the first directory from a 'FilePath'. Should only be used on---   relative paths.------ > dropDirectory1 "aaa/bbb" == "bbb"--- > dropDirectory1 "aaa/" == ""--- > dropDirectory1 "aaa" == ""--- > dropDirectory1 "" == ""-dropDirectory1 :: FilePath -> FilePath-dropDirectory1 = drop 1 . dropWhile (not . Native.isPathSeparator)----- | Take the first component of a 'FilePath'. Should only be used on---   relative paths.------ > takeDirectory1 "aaa/bbb" == "aaa"--- > takeDirectory1 "aaa/" == "aaa"--- > takeDirectory1 "aaa" == "aaa"-takeDirectory1 :: FilePath -> FilePath-takeDirectory1 = takeWhile (not . Native.isPathSeparator)----- | Normalise a 'FilePath', applying the standard 'FilePath' normalisation, plus---   translating any path separators to @\/@ and removing @foo\/..@ components where possible.-normalise :: FilePath -> FilePath-normalise = intercalate "/" . dropDots . split . Native.normalise-    where-        dropDots = reverse . f 0 . reverse-            where-                f i ("..":xs) = f (i+1) xs-                f 0 (x:xs) = x : f 0 xs-                f i (x:xs) = f (i-1) xs-                f i [] = replicate i ".."--        split xs = a : if null b then [] else split $ tail b-            where (a,b) = break Native.isPathSeparator xs----- | Convert to native path separators, namely @\\@ on Windows. -toNative :: FilePath -> FilePath-toNative = map (\x -> if Native.isPathSeparator x then Native.pathSeparator else x)----- | Combine two file paths, an alias for 'combine'.-(</>) :: FilePath -> FilePath -> FilePath-(</>) = combine----- | Combine two file paths. Any leading @.\/@ or @..\/@ components in the right file---   are eliminated.------ > combine "aaa/bbb" "ccc" == "aaa/bbb/ccc"--- > combine "aaa/bbb" "./ccc" == "aaa/bbb/ccc"--- > combine "aaa/bbb" "../ccc" == "aaa/ccc"-combine :: FilePath -> FilePath -> FilePath-combine "." y = y-combine x ('.':'.':'/':y) = combine (takeDirectory x) y-combine x ('.':'/':y) = combine x y-combine x y = normalise $ Native.combine (toNative x) (toNative y)
− Development/Shake/FilePattern.hs
@@ -1,77 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving, DeriveDataTypeable #-}--module Development.Shake.FilePattern(-    FilePattern, (?==),-    compatible, extract, substitute-    ) where--import Data.List----- | A type synonym for file patterns, containing @\/\/@ and @*@. For the syntax---   and semantics of 'FilePattern' see '?=='.-type FilePattern = String----- | Match a 'FilePattern' against a 'FilePath', There are only two special forms:------ * @*@ matches an entire path component, excluding any separators.------ * @\/\/@ matches an arbitrary number of path componenets.------   Some examples that match:------ > "//*.c" ?== "foo/bar/baz.c"--- > "*.c" ?== "baz.c"--- > "//*.c" ?== "baz.c"--- > "test.c" ?== "test.c"------   Examples that /don't/ match:------ > "*.c" ?== "foo/bar.c"--- > "*/*.c" ?== "foo/bar/baz.c"----(?==) :: FilePattern -> FilePath -> Bool-(?==) ('/':'/':p) x = any (p ?==) $ x : [i | '/':i <- tails x]-(?==) ('*':p) x = any (p ?==) $ a ++ take 1 b-    where (a,b) = break ("/" `isPrefixOf`) $ tails x-(?==) (p:ps) (x:xs) | p == x = ps ?== xs-(?==) [] [] = True-(?==) _ _ = False----- | Do they have the same * and // counts in the same order-compatible :: [FilePattern] -> Bool-compatible [] = True-compatible (x:xs) = all ((==) (f x) . f) xs-    where-        f ('*':xs) = '*':f xs-        f ('/':'/':xs) = '/':f xs-        f (x:xs) = f xs-        f [] = []----- | Extract the items that match the wildcards. The pair must match with '?=='.-extract :: FilePattern -> FilePath -> [String]-extract p x = head $ f p x ++ [[]]-    where-        f ('/':'/':p) x = rest p $ ("",x) : [(pre++"/",i) | (pre,'/':i) <- zip (inits x) (tails x)]-        f ('*':p) x = rest p $ a ++ take 1 b-            where (a,b) = break (isPrefixOf "/" . snd) $ zip (inits x) (tails x)-        f (p:ps) (x:xs) | p == x = f ps xs-        f [] [] = [[]]-        f _ _ = []--        rest p xs = [skip:res | (skip,keep) <- xs, res <- f p keep]----- | Given the result of 'extract', substitute it back in to a 'compatible' pattern.------ > p '?==' x ==> substitute (extract p x) p == x-substitute :: [String] -> FilePattern -> FilePath-substitute = f-    where-        f (a:as) ('/':'/':ps) = a ++ f as ps-        f (a:as) ('*':ps) = a ++ f as ps-        f as (p:ps) = p : f as ps-        f as [] = []
− Development/Shake/FileTime.hs
@@ -1,40 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving, DeriveDataTypeable #-}--module Development.Shake.FileTime(-    FileTime,-    getModTimeError, getModTimeMaybe-    ) where--import Control.DeepSeq-import Data.Binary-import Data.Hashable-import Data.Typeable-import System.Directory-import System.IO.Error-import Control.Exception-import System.Time---newtype FileTime = FileTime Int-    deriving (Typeable,Eq,Hashable,Binary,Show,NFData)---getModTimeMaybe :: FilePath -> IO (Maybe FileTime)-getModTimeMaybe x =-    fmap Just (getModTime x) `Control.Exception.catch` \e ->-        if isDoesNotExistError e then return Nothing else ioError e---getModTimeError :: String -> FilePath -> IO FileTime-getModTimeError msg x = do-    res <- getModTimeMaybe x-    case res of-        -- Make sure you raise an error in IO, not return a value which will error later-        Nothing -> error $ msg ++ "\n" ++ x-        Just x -> return x---getModTime :: FilePath -> IO FileTime-getModTime x = do-    TOD t _ <- getModificationTime x-    return $ FileTime $ fromIntegral t
− Development/Shake/Files.hs
@@ -1,96 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving, DeriveDataTypeable #-}--module Development.Shake.Files(-    (?>>), (*>>)-    ) where--import Control.DeepSeq-import Control.Monad-import Control.Monad.IO.Class-import Data.Binary-import Data.Hashable-import Data.Maybe-import Data.Typeable--import Development.Shake.Core-import Development.Shake.File-import Development.Shake.FilePattern-import Development.Shake.FileTime--infix 1 ?>>, *>>---newtype Files = Files [FilePath]-    deriving (Typeable,Eq,Hashable,Binary,NFData)--newtype FileTimes = FileTimes [FileTime]-    deriving (Typeable,Show,Eq,Hashable,Binary,NFData)--instance Show Files where show (Files xs) = unwords xs---instance Rule Files FileTimes where-    validStored (Files xs) (FileTimes ts) = fmap (== map Just ts) $ mapM getModTimeMaybe xs----- | Define a rule for building multiple files at the same time.---   As an example, a single invokation of GHC produces both @.hi@ and @.o@ files:------ @--- [\"*.o\",\"*.hi\"] '*>>' \\[o,hi] -> do---     let hs = 'Development.Shake.FilePath.replaceExtension' o \"hs\"---     'Development.Shake.need' ... -- all files the .hs import---     'Development.Shake.system'' \"ghc\" [\"-c\",hs]--- @------   However, in practice, it's usually easier to define rules with '*>' and make the @.hi@ depend---   on the @.o@. When defining rules that build multiple files, all the 'FilePattern' values must---   have the same sequence of @\/\/@ and @*@ wildcards in the same order.-(*>>) :: [FilePattern] -> ([FilePath] -> Action ()) -> Rules ()-ps *>> act-    | not $ compatible ps = error $-        "All patterns to *>> must have the same number and position of // and * wildcards\n" ++-        unwords ps-    | otherwise = do-        forM_ ps $ \p ->-            p *> \file -> do-                apply1 $ Files $ map (substitute $ extract p file) ps :: Action FileTimes-                return ()-        rule $ \(Files xs) -> if not $ length xs == length ps && and (zipWith (?==) ps xs) then Nothing else Just $ do-            act xs-            liftIO $ fmap FileTimes $ mapM (getModTimeError "Error, *>> failed to build the file:") xs----- | Define a rule for building multiple files at the same time, a more powerful---   and more dangerous version of '*>>'.------   Given an application @test ?>> ...@, @test@ should return @Just@ if the rule applies, and should---   return the list of files that will be produced. This list /must/ include the file passed as an argument and should---   obey the invariant:------ > test x == Just ys ==> x `elem` ys && all ((== Just ys) . test) ys------   As an example of a function satisfying the invariaint:------ > test x | takeExtension x `elem` [".hi",".o"]--- >        = Just [dropExtension x <.> "hi", dropExtension x <.> "o"]--- > test _ = Nothing------   Regardless of whether @Foo.hi@ or @Foo.o@ is passed, the function always returns @[Foo.hi, Foo.o]@.-(?>>) :: (FilePath -> Maybe [FilePath]) -> ([FilePath] -> Action ()) -> Rules ()-(?>>) test act = do-    let checkedTest x = case test x of-            Nothing -> Nothing-            Just ys | x `elem` ys && all ((== Just ys) . test) ys -> Just ys-                    | otherwise -> error $ "Invariant broken in ?>> when trying on " ++ x--    isJust . checkedTest ?> \x -> do-        apply1 $ Files $ fromJust $ test x :: Action FileTimes-        return ()--    rule $ \(Files xs@(x:_)) -> case checkedTest x of-        Just ys | ys == xs -> Just $ do-            act xs-            liftIO $ fmap FileTimes $ mapM (getModTimeError "Error, multi rule failed to build the file:") xs-        Just ys -> error $ "Error, ?>> is incompatible with " ++ show xs ++ " vs " ++ show ys-        Nothing -> Nothing
− Development/Shake/Locks.hs
@@ -1,139 +0,0 @@--module Development.Shake.Locks(-    Lock, newLock, withLock,-    Var, newVar, readVar, modifyVar, modifyVar_,-    Barrier, newBarrier, signalBarrier, waitBarrier,-    Resource, newResource, acquireResource, releaseResource-    ) where--import Control.Concurrent-import Control.Monad--------------------------------------------------------------------------- LOCK---- | Like an MVar, but has no value-newtype Lock = Lock (MVar ())-instance Show Lock where show _ = "Lock"--newLock :: IO Lock-newLock = fmap Lock $ newMVar ()--withLock :: Lock -> IO a -> IO a-withLock (Lock x) = withMVar x . const--------------------------------------------------------------------------- VAR---- | Like an MVar, but must always be full-newtype Var a = Var (MVar a)-instance Show (Var a) where show _ = "Var"--newVar :: a -> IO (Var a)-newVar = fmap Var . newMVar--readVar :: Var a -> IO a-readVar (Var x) = readMVar x--modifyVar :: Var a -> (a -> IO (a, b)) -> IO b-modifyVar (Var x) f = modifyMVar x f--modifyVar_ :: Var a -> (a -> IO a) -> IO ()-modifyVar_ (Var x) f = modifyMVar_ x f--------------------------------------------------------------------------- BARRIER---- | Starts out empty, then is filled exactly once-newtype Barrier a = Barrier (MVar a)-instance Show (Barrier a) where show _ = "Barrier"--newBarrier :: IO (Barrier a)-newBarrier = fmap Barrier newEmptyMVar--signalBarrier :: Barrier a -> a -> IO ()-signalBarrier (Barrier x) = putMVar x--waitBarrier :: Barrier a -> IO a-waitBarrier (Barrier x) = readMVar x--------------------------------------------------------------------------- RESOURCE---- | The type representing a finite resource, which multiple build actions should respect.---   Created with 'newResource' in the 'IO' monad before calling 'Development.Shake.shake',---   and used with 'Development.Shake.withResource' in the 'Development.Shake.Action' monad---   when defining rules.------   As an example, only one set of calls to the Excel API can occur at one time, therefore---   Excel is a finite resource of quantity 1. You can write:------ @--- do excel <- 'newResource' \"Excel\" 1---    'Development.Shake.shake' 'Development.Shake.shakeOptions'{'Development.Shake.shakeThreads'=2} $ do---        'Development.Shake.want' [\"a.xls\",\"b.xls\"]---        \"*.xls\" 'Development.Shake.*>' \\out ->---            'Development.Shake.withResource' excel 1 $---                'Development.Shake.system'' \"excel\" [out,...]---  @------   Now the two calls to @excel@ will not happen in parallel. Using 'Resource'---   is better than 'MVar' as it will not block any other threads from executing. Be careful that the---   actions run within 'Development.Shake.withResource' do not themselves require further quantities of this resource, or---   you may get a \"thread blocked indefinitely in an MVar operation\" exception. Typically only---   system commands (such as 'Development.Shake.system'') will be run inside 'Development.Shake.withResource',---   not commands such as 'Development.Shake.need'.------   As another example, calls to compilers are usually CPU bound but calls to linkers are usually---   disk bound. Running 8 linkers will often cause an 8 CPU system to grid to a halt. We can limit---   ourselves to 4 linkers with:------ @--- do disk <- 'newResource' \"Disk\" 4---    'Development.Shake.shake' 'Development.Shake.shakeOptions'{'Development.Shake.shakeThreads'=8} $ do---        'Development.Shake.want' [show i 'Development.Shake.FilePath.<.>' \"exe\" | i <- [1..100]]---        \"*.exe\" 'Development.Shake.*>' \\out ->---            'Development.Shake.withResource' disk 1 $---                'Development.Shake.system'' \"ld\" [\"-o\",out,...]---        \"*.o\" 'Development.Shake.*>' \\out ->---            'Development.Shake.system'' \"cl\" [\"-o\",out,...]--- @-data Resource = Resource String Int (Var (Int,[(Int,IO ())]))-instance Show Resource where show (Resource name _ _) = "Resource " ++ name----- | Create a new finite resource, given a name (for error messages) and a quantity of the resource that exists.---   For an example see 'Resource'.-newResource :: String -> Int -> IO Resource-newResource name mx = do-    when (mx < 0) $-        error $ "You cannot create a resource named " ++ name ++ " with a negative quantity, you used " ++ show mx-    var <- newVar (mx, [])-    return $ Resource name mx var----- | Try to acquire a resource. Returns Nothing to indicate you have acquired with no blocking, or Just act to---   say after act completes (which will block) then you will have the resource.-acquireResource :: Resource -> Int -> IO (Maybe (IO ()))-acquireResource r@(Resource name mx var) want-    | want < 0 = error $ "You cannot acquire a negative quantity of " ++ show r ++ ", requested " ++ show want-    | want > mx = error $ "You cannot acquire more than " ++ show mx ++ " of " ++ show r ++ ", requested " ++ show want-    | otherwise = modifyVar var $ \(available,waiting) ->-        if want <= available then-            return ((available - want, waiting), Nothing)-        else do-            bar <- newBarrier-            return ((available, waiting ++ [(want,signalBarrier bar ())]), Just $ waitBarrier bar)----- | You should only ever releaseResource that you obtained with acquireResource.-releaseResource :: Resource -> Int -> IO ()-releaseResource (Resource name mx var) i = modifyVar_ var $ \(available,waiting) -> f (available+i) waiting-    where-        f i ((wi,wa):ws) | wi <= i = wa >> f (i-wi) ws-                         | otherwise = do (i,ws) <- f i ws; return (i,(wi,wa):ws)-        f i [] = return (i, [])
− Development/Shake/Oracle.hs
@@ -1,52 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving, DeriveDataTypeable, ScopedTypeVariables #-}--module Development.Shake.Oracle(-    addOracle, askOracle-    ) where--import Control.DeepSeq-import Data.Binary-import Data.Hashable-import Data.Typeable--import Development.Shake.Core---newtype Question = Question [String]-    deriving (Typeable,Eq,Hashable,Binary,NFData)-newtype Answer = Answer [String]-    deriving (Show,Typeable,Eq,Hashable,Binary,NFData)--instance Show Question where-    show (Question xs) = "Oracle " ++ unwords xs--instance Rule Question Answer where-    validStored _ _ = return False----- | Add extra information which your build should depend on. For example:------ > addOracle ["ghc"] $ return ["7.2.1"]--- > addOracle ["ghc-pkg","shake"] $ return ["1.0"]------   If a rule depends on the GHC version, it can then use @'askOracle' [\"ghc\"]@, and---   if the GHC version changes, the rule will rebuild. It is common for the value returned---   by 'askOracle' to be ignored.------   The Oracle maps questions of @[String]@ and answers of @[String]@. This type is a---   compromise. Questions will often be the singleton list, but allowing a list of strings---   there is more flexibility for heirarchical schemes and grouping - i.e. to have---   @ghc-pkg shake@, @ghc-pkg base@ etc. The answers are often singleton lists, but---   sometimes are used as sets - for example the list of packages returned by @ghc-pkg@.------   Actions passed to 'addOracle' will be run in every Shake execution they are required,---   their value will not be kept between runs. To get a similar behaviour using files, see---   'Development.Shake.alwaysRerun'.-addOracle :: [String] -> Action [String] -> Rules ()-addOracle question act = rule $ \(Question q) ->-    if q == question then Just $ fmap Answer act else Nothing----- | Get information previously added with 'addOracle'.-askOracle :: [String] -> Action [String]-askOracle question = do Answer answer <- apply1 $ Question question; return answer
− Development/Shake/Pool.hs
@@ -1,120 +0,0 @@---- | Thread pool implementation.-module Development.Shake.Pool(Pool, addPool, blockPool, runPool) where--import Control.Concurrent-import Control.Exception hiding (blocked)-import Development.Shake.Locks-import qualified Data.HashSet as Set--------------------------------------------------------------------------- SUPER QUEUE---- FIXME: The super queue should use randomness for the normal priority pile--data SuperQueue a = SuperQueue [a] [a]--newSuperQueue :: SuperQueue a-newSuperQueue = SuperQueue [] []--enqueuePriority :: a -> SuperQueue a -> SuperQueue a-enqueuePriority x (SuperQueue p n) = SuperQueue (x:p) n--enqueue :: a -> SuperQueue a -> SuperQueue a-enqueue x (SuperQueue p n) = SuperQueue p (x:n)--dequeue :: SuperQueue a -> Maybe (a, SuperQueue a)-dequeue (SuperQueue (p:ps) ns) = Just (p, SuperQueue ps ns)-dequeue (SuperQueue [] (n:ns)) = Just (n, SuperQueue [] ns)-dequeue (SuperQueue [] []) = Nothing--------------------------------------------------------------------------- THREAD POOL--{--Must keep a list of active threads, so can raise exceptions in a timely manner-Must spawn a fresh thread to do blockPool-If any worker throws an exception, must signal to all the other workers--}--data Pool = Pool Int (Var (Maybe S)) (Barrier (Maybe SomeException))--data S = S-    {threads :: Set.HashSet ThreadId-    ,working :: Int -- threads which are actively working-    ,blocked :: Int -- threads which are blocked-    ,todo :: SuperQueue (IO ())-    }---emptyS :: S-emptyS = S Set.empty 0 0 newSuperQueue----- | Given a pool, and a function that breaks the S invariants, restore them---   They are only allowed to touch working or todo-step :: Pool -> (S -> S) -> IO ()-step pool@(Pool n var done) op = do-    let onVar act = modifyVar_ var $ maybe (return Nothing) act-    onVar $ \s -> do-        s <- return $ op s-        case dequeue (todo s) of-            Just (now, todo2) | working s < n -> do-                -- spawn a new worker-                t <- forkIO $ do-                    t <- myThreadId-                    res <- try now-                    case res of-                        Left e -> onVar $ \s -> do-                            mapM_ killThread $ Set.toList $ Set.delete t $ threads s-                            signalBarrier done $ Just e-                            return Nothing-                        Right _ -> step pool $ \s -> s{working = working s - 1, threads = Set.delete t $ threads s}-                return $ Just s{working = working s + 1, todo = todo2, threads = Set.insert t $ threads s}-            Nothing | working s == 0 && blocked s == 0 -> do-                signalBarrier done Nothing-                return Nothing-            _ -> return $ Just s----- | Add a new task to the pool-addPool :: Pool -> IO a -> IO ()-addPool pool act = step pool $ \s -> s{todo = enqueue (act >> return ()) (todo s)}----- | A blocking action is being run while on the pool, yeild your thread.---   Should only be called by an action under addPool.-blockPool :: Pool -> IO a -> IO a-blockPool pool act = do-    step pool $ \s -> s{working = working s - 1, blocked = blocked s + 1}-    res <- act-    var <- newBarrier-    let act = do-            step pool $ \s -> s{working = working s + 1, blocked = blocked s - 1}-            signalBarrier var ()-    step pool $ \s -> s{todo = enqueuePriority act $ todo s}-    waitBarrier var-    return res----- | Run all the tasks in the pool on the given number of works.---   If any thread throws an exception, the exception will be reraised.-runPool :: Int -> (Pool -> IO ()) -> IO () -- run all tasks in the pool-runPool n act = do-    s <- newVar $ Just emptyS-    let cleanup = modifyVar_ s $ \s -> do-            -- if someone kills our thread, make sure we kill our child threads-            case s of-                Just s -> mapM_ killThread $ Set.toList $ threads s-                Nothing -> return ()-            return Nothing-    flip onException cleanup $ do-        res <- newBarrier-        let pool = Pool n s res-        addPool pool $ act pool-        res <- waitBarrier res-        case res of-            Nothing -> return ()-            Just e -> throw e
− Development/Shake/Report.hs
@@ -1,26 +0,0 @@-{-# LANGUAGE PatternGuards #-}--module Development.Shake.Report(buildReport) where--import Control.Monad-import System.FilePath-import Paths_shake----- | Generates an HTML report given some build system---   profiling data in JSON format.-buildReport :: String -> FilePath -> IO ()-buildReport json out = do-    htmlDir <- getDataFileName "html"-    report <- readFile $ htmlDir </> "report.html"-    let f name | name == "data" = return json-               | otherwise = readFile $ htmlDir </> name-    writeFile out =<< runTemplate f report----- | Template Engine-runTemplate :: Monad m => (String -> m String) -> String -> m String-runTemplate ask ('$':'$':xs) = liftM ('$':) $ runTemplate ask xs-runTemplate ask ('$':xs) | (name,_:rest) <- break (== '$') xs = liftM2 (++) (ask name) (runTemplate ask rest)-runTemplate ask (x:xs) = liftM (x:) $ runTemplate ask xs-runTemplate ask [] = return []
− Development/Shake/Rerun.hs
@@ -1,41 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving, DeriveDataTypeable, ScopedTypeVariables #-}--module Development.Shake.Rerun(-    defaultRuleRerun, alwaysRerun-    ) where--import Control.DeepSeq-import Data.Binary-import Data.Hashable-import Data.Typeable--import Development.Shake.Core---newtype AlwaysRerun = AlwaysRerun ()-    deriving (Typeable,Eq,Hashable,Binary,NFData)-instance Show AlwaysRerun where show _ = "AlwaysRerun"--newtype Dirty = Dirty ()-    deriving (Typeable,Hashable,Binary,NFData)-instance Show Dirty where show _ = "Dirty"-instance Eq Dirty where a == b = False--instance Rule AlwaysRerun Dirty where-    validStored _ _ = return False----- | Always rerun the associated action. Useful for defining rules that query---   the environment. For example:------ @--- \"ghcVersion.txt\" 'Development.Shake.*>' \\out -> do---     'alwaysRerun'---     (stdout,_) <- 'Development.Shake.systemOutput' \"ghc\" [\"--version\"]---     'Development.Shake.writeFileChanged' out stdout--- @-alwaysRerun :: Action ()-alwaysRerun = do Dirty _ <- apply1 $ AlwaysRerun (); return ()--defaultRuleRerun :: Rules ()-defaultRuleRerun = defaultRule $ \AlwaysRerun{} -> Just $ return $ Dirty ()
− Development/Shake/Storage.hs
@@ -1,181 +0,0 @@-{-# LANGUAGE ScopedTypeVariables, PatternGuards #-}-{--This module stores the meta-data so its very important its always accurate-We can't rely on getting any exceptions or termination at the end, so we'd better write out a journal-We store a series of records, and if they contain twice as many records as needed, we compress--}--module Development.Shake.Storage(-    withStorage-    ) where--import Development.Shake.Binary-import Development.Shake.Locks--import Prelude hiding (catch)-import Control.Arrow-import Control.DeepSeq-import Control.Exception-import Control.Monad-import Data.Binary.Get-import Data.Binary.Put-import Data.Char-import Data.Hashable-import qualified Data.HashMap.Strict as Map-import Data.List-import System.Directory-import System.Exit-import System.FilePath-import System.IO--import qualified Data.ByteString.Lazy.Char8 as LBS---type Map = Map.HashMap---- Increment every time the on-disk format/semantics change,--- @i@ is for the users version number-databaseVersion i = "SHAKE-DATABASE-4-" ++ show (i :: Int) ++ "\r\n"---withStorage-    :: (Eq w, Eq k, Hashable k-       ,Binary w, BinaryWith w k, BinaryWith w v)-    => (String -> IO ())        -- ^ Logging function-    -> FilePath                 -- ^ File prefix to use-    -> Int                      -- ^ User supplied version number-    -> w                        -- ^ Witness-    -> (Map k v -> (k -> Maybe v -> IO ()) -> IO a)  -- ^ Execute-    -> IO a-withStorage logger file version witness act = do-    let dbfile = file <.> "database"-        bupfile = file <.> "bup"-    createDirectoryIfMissing True $ takeDirectory file--    -- complete a partially failed compress-    b <- doesFileExist bupfile-    when b $ do-        logger $ "Backup file move to original"-        catch (removeFile dbfile) (\(e :: SomeException) -> return ())-        renameFile bupfile dbfile--    withBinaryFile dbfile ReadWriteMode $ \h -> do-        n <- hFileSize h-        logger $ "Reading file of size " ++ show n-        src <- LBS.hGet h $ fromInteger n--        if not $ ver `LBS.isPrefixOf` src then do-            unless (LBS.null src) $ do-                let good x = isAlphaNum x || x `elem` "-_ "-                let bad = LBS.takeWhile good $ LBS.take 50 src-                putStr $ unlines-                    ["Error when reading Shake database " ++ dbfile-                    ,"  Invalid version stamp detected"-                    ,"  Expected: " ++ takeWhile good (LBS.unpack ver)-                    ,"  Found   : " ++ LBS.unpack bad-                    ,"All files will be rebuilt"]-            continue h Map.empty-         else-            -- make sure you are not handling exceptions from inside-            join $ handleJust (\e -> if asyncException e then Nothing else Just e) (\err -> do-                msg <- showException err-                putStrLn $ unlines $-                    ("Error when reading Shake database " ++ dbfile) :-                    map ("  "++) (lines msg) ++-                    ["All files will be rebuilt"]-                -- exitFailure -- should never happen without external corruption-                               -- add back to check during random testing-                return $ continue h Map.empty) $-                case readChunks $ LBS.drop (LBS.length ver) src of-                    (slop, []) -> do-                        logger $ "Read 0 chunks, plus " ++ show slop ++ " slop"-                        return $ continue h Map.empty-                    (slop, w:xs) -> do-                        logger $ "Read " ++ show (length xs + 1) ++ " chunks, plus " ++ show slop ++ " slop"-                        logger $ "Chunk sizes " ++ show (map LBS.length (w:xs))-                        let ws = decode w-                            f mp (k, Nothing) = Map.delete k mp-                            f mp (k, Just v ) = Map.insert k v mp-                            mp = foldl' f Map.empty $ map (runGet $ getWith ws) xs-                        -- if mp is null, continue will reset it, so no need to clean up-                        if Map.null mp || (ws == witness && Map.size mp * 2 > length xs - 2) then do-                            -- make sure we reset to before the slop-                            when (not (Map.null mp) && slop /= 0) $ do-                                logger $ "Dropping last " ++ show slop ++ " bytes of database (incomplete)"-                                now <- hFileSize h-                                hSetFileSize h $ now - slop-                                hSeek h AbsoluteSeek $ now - slop-                                hFlush h-                                logger $ "Drop complete"-                            return $ continue h mp-                         else do-                            logger "Compressing database"-                            hClose h -- two hClose are fine-                            return $ do-                                renameFile dbfile bupfile-                                withBinaryFile dbfile ReadWriteMode $ \h -> do-                                    reset h mp-                                    removeFile bupfile-                                    logger "Compression complete"-                                    continue h mp-    where-        ver = LBS.pack $ databaseVersion version--        writeChunk h s = do-            logger $ "Writing chunk " ++ show (LBS.length s)-            LBS.hPut h $ toChunk s--        reset h mp = do-            logger $ "Resetting database to " ++ show (Map.size mp) ++ " elements"-            hSetFileSize h 0-            hSeek h AbsoluteSeek 0-            LBS.hPut h ver-            writeChunk h $ encode witness-            mapM_ (writeChunk h . runPut . putWith witness . second Just) $ Map.toList mp-            hFlush h-            logger "Flush"--        -- continuation (since if we do a compress, h changes)-        continue h mp = do-            when (Map.null mp) $-                reset h mp -- might as well, no data to lose, and need to ensure a good witness table-            lock <- newLock-            act mp $ \k v -> do-                -- QUESTION: Should the logging be on a different thread? Does that reduce blocking?-                withLock lock $ writeChunk h $ runPut $ putWith witness (k,v)-                hFlush h-                logger "Flush"----- Return the amount of junk at the end, along with all the chunk-readChunks :: LBS.ByteString -> (Integer, [LBS.ByteString])-readChunks x-    | Just (n, x) <- grab 4 x-    , Just (y, x) <- grab (fromIntegral (decode n :: Word32)) x-    = second (y :) $ readChunks x-    | otherwise = (toInteger $ LBS.length x, [])-    where-        grab i x | LBS.length a == i = Just (a, b)-                 | otherwise = Nothing-            where (a,b) = LBS.splitAt i x---toChunk :: LBS.ByteString -> LBS.ByteString-toChunk x = n `LBS.append` x-    where n = encode (fromIntegral $ LBS.length x :: Word32)----- Some exceptions may have an error message which is itself an exception,--- make sure you show them properly-showException :: SomeException -> IO String-showException err = do-    let msg = show err-    catch (evaluate $ rnf msg `seq` msg) (\(_ :: SomeException) -> return "Unknown exception (error while showing error message)")----- | Is the exception asyncronous, not a "coding error" that should be ignored-asyncException :: SomeException -> Bool-asyncException e-    | Just (_ :: AsyncException) <- fromException e = True-    | Just (_ :: ExitCode) <- fromException e = True-    | otherwise = False
− Development/Shake/Value.hs
@@ -1,125 +0,0 @@-{-# LANGUAGE ExistentialQuantification, GeneralizedNewtypeDeriving, MultiParamTypeClasses #-}--{- |-This module implements the Key/Value types, to abstract over hetrogenous data types.--}-module Development.Shake.Value(-    Value, newValue, fromValue, typeValue,-    Key, newKey, fromKey, typeKey,-    Witness, currentWitness, registerWitness-    ) where--import Development.Shake.Binary-import Control.DeepSeq-import Data.Hashable-import Data.Typeable--import Data.Bits-import Data.IORef-import Data.Maybe-import qualified Data.HashMap.Strict as Map-import System.IO.Unsafe----- We deliberately avoid Typeable instances on Key/Value to stop them accidentally--- being used inside themselves-newtype Key = Key Value-    deriving (Eq,Hashable,NFData,BinaryWith Witness)--data Value = forall a . (Eq a, Show a, Typeable a, Hashable a, Binary a, NFData a) => Value a---newKey :: (Eq a, Show a, Typeable a, Hashable a, Binary a, NFData a) => a -> Key-newKey = Key . newValue--newValue :: (Eq a, Show a, Typeable a, Hashable a, Binary a, NFData a) => a -> Value-newValue = Value--typeKey :: Key -> TypeRep-typeKey (Key v) = typeValue v--typeValue :: Value -> TypeRep-typeValue (Value x) = typeOf x--fromKey :: Typeable a => Key -> a-fromKey (Key v) = fromValue v--fromValue :: Typeable a => Value -> a-fromValue (Value x) = fromMaybe (error msg) $ cast x-    where msg = "Internal error in Shake.fromValue, bad cast"--instance Show Key where-    show (Key a) = show a--instance Show Value where-    show (Value a) = show a--instance NFData Value where-    rnf (Value a) = rnf a--instance Hashable Value where-    hash (Value a) = hash (typeOf a) `xor` hash a--instance Eq Value where-    Value a == Value b = case cast b of-        Just bb -> a == bb-        Nothing -> False--------------------------------------------------------------------------- BINARY INSTANCES--{-# NOINLINE witness #-}-witness :: IORef (Map.HashMap TypeRep Value)-witness = unsafePerformIO $ newIORef Map.empty--registerWitness :: (Eq a, Show a, Typeable a, Hashable a, Binary a, NFData a) => a -> IO ()-registerWitness x = modifyIORef witness $ Map.insert (typeOf x) (Value $ undefined `asTypeOf` x)---data Witness = Witness-    {typeNames :: [String] -- the canonical data, the names of the types-    ,witnessIn :: Map.HashMap Int Value -- for reading in, the find the values (some may be missing)-    ,witnessOut :: Map.HashMap TypeRep Int -- for writing out, find the value-    }--instance Eq Witness where-    -- type names are ordered by the Map (on hash), so likely to remain reasonably consistent-    -- regardless of the order of registerWitness calls-    a == b = typeNames a == typeNames b--currentWitness :: IO Witness-currentWitness = do-    ws <- readIORef witness-    let (ks,vs) = unzip $ Map.toList ws-    return $ Witness (map show ks) (Map.fromList $ zip [0..] vs) (Map.fromList $ zip ks [0..])---instance Binary Witness where-    put (Witness ts _ _) = put ts-    get = do-        ts <- get-        let ws = Map.toList $ unsafePerformIO $ readIORef witness-        let (is,ks,vs) = unzip3 [(i,k,v) | (i,t) <- zip [0..] ts, (k,v):_ <- [filter ((==) t . show . fst) ws]]-        return $ Witness ts (Map.fromList $ zip is vs) (Map.fromList $ zip ks is)---instance BinaryWith Witness Value where-    -- FIXME: Should probably be writing out bytes, rather than 64 bit Int's-    putWith ws (Value x) = do-        let msg = "Internal error, could not find witness type for " ++ show (typeOf x)-        put $ fromMaybe (error msg) $ Map.lookup (typeOf x) (witnessOut ws)-        put x--    getWith ws = do-        h <- get-        case Map.lookup h $ witnessIn ws of-            Nothing | h >= 0 && h < length (typeNames ws) -> error $-                "Failed to find a type " ++ (typeNames ws !! fromIntegral h) ++ " which is stored in the database.\n" ++-                "The most likely cause is that your build tool has changed significantly."-            Nothing -> error $-                -- should not happen, unless proper data corruption-                "Corruption when reading Value, got type " ++ show h ++ ", but should be in range 0.." ++ show (length (typeNames ws) - 1)-            Just (Value t) -> do-                x <- get-                return $ Value $ x `asTypeOf` t
− Examples/C/Main.hs
@@ -1,28 +0,0 @@--module Examples.C.Main(main) where--import Development.Shake-import Development.Shake.FilePath-import Examples.Util--main = shaken noTest $ \args obj -> do-    let src = "Examples/C"-    want [obj "Main.exe"]--    obj "Main.exe" *> \out -> do-        cs <- getDirectoryFiles src "*.c"-        let os = map (obj . (<.> "o")) cs-        need os-        system' "gcc" $ ["-o",out] ++ os--    obj "*.c.o" *> \out -> do-        let c = src </> takeBaseName out-        need [c]-        headers <- cIncludes c-        need $ map ((</>) src . takeFileName) headers-        system' "gcc" ["-o",out,"-c",c]--cIncludes :: FilePath -> Action [FilePath]-cIncludes x = do-    (stdout,_) <- systemOutput "gcc" ["-MM",x]-    return $ drop 2 $ words stdout
− Examples/C/constants.c
@@ -1,7 +0,0 @@--char msg[] = "Hello Shake Users!";--char* message()-{-	return msg;-}
− Examples/C/constants.h
@@ -1,1 +0,0 @@-char* message();
− Examples/C/main.c
@@ -1,8 +0,0 @@-#include <stdio.h>-#include "constants.h"--int main()-{-	printf("%s\n", message());-	return 0;-}
− Examples/Self/Main.hs
@@ -1,80 +0,0 @@--module Examples.Self.Main(main) where--import Development.Shake-import Development.Shake.FilePath-import Examples.Util--import Control.Monad-import Data.Char-import Data.List---main :: IO ()-main = shaken noTest $ \args obj -> do-    let moduleToFile ext xs = map (\x -> if x == '.' then '/' else x) xs <.> ext-    want $ if null args then [obj "Main.exe"] else args--    -- fixup to cope with Cabal's generated files-    let fixPaths x = if x == "Paths_shake.hs" then "Paths.hs" else x--    let ghc args = do-            -- since ghc-pkg includes the ghc package, it changes if the version does-            askOracle ["ghc-pkg"]-            flags <- askOracle ["ghc-flags"]-            system' "ghc" $ args ++ flags--    obj "/*.exe" *> \out -> do-        src <- readFileLines $ replaceExtension out "deps"-        let os = map (obj . moduleToFile "o") $ "Main":src-        need os-        ghc $ ["-o",out] ++ os--    obj "/*.deps" *> \out -> do-        dep <- readFileLines $ replaceExtension out "dep"-        let xs = map (obj . moduleToFile "deps") dep-        need xs-        ds <- fmap (nub . sort . (++) dep . concat) $ mapM readFileLines xs-        writeFileLines out ds--    obj "/*.dep" *> \out -> do-        src <- readFile' $ fixPaths $ unobj $ replaceExtension out "hs"-        let xs = hsImports src-        xs <- filterM (doesFileExist . fixPaths . moduleToFile "hs") xs-        writeFileLines out xs--    obj "/*.hi" *> \out -> do-        need [replaceExtension out "o"]--    obj "/*.o" *> \out -> do-        dep <- readFileLines $ replaceExtension out "dep"-        let hs = fixPaths $ unobj $ replaceExtension out "hs"-        need $ hs : map (obj . moduleToFile "hi") dep-        ghc ["-c",hs,"-hide-all-packages","-odir=output/self","-hidir=output/self","-i=output/self"]--    obj ".pkgs" *> \out -> do-        src <- readFile' "shake.cabal"-        writeFileLines out $ sort $ cabalBuildDepends src--    addOracle ["ghc-pkg"] $ do-        (out,_) <- systemOutput "ghc-pkg" ["list","--simple-output"]-        return $ words out--    addOracle ["ghc-flags"] $ do-        pkgs <- readFileLines $ obj ".pkgs"-        return $ map ("-package=" ++) pkgs--------------------------------------------------------------------------- GRAB INFORMATION FROM FILES--hsImports :: String -> [String]-hsImports xs = [ takeWhile (\x -> isAlphaNum x || x `elem` "._") $ dropWhile (not . isUpper) x-               | x <- lines xs, "import " `isPrefixOf` x]----- FIXME: Should actually parse the list from the contents of the .cabal file-cabalBuildDepends :: String -> [String]-cabalBuildDepends _ = words $-    "base transformers binary unordered-containers hashable time old-time bytestring " ++-    "filepath directory process deepseq random"
− Examples/Tar/Main.hs
@@ -1,14 +0,0 @@--module Examples.Tar.Main(main) where--import Development.Shake-import Examples.Util---main :: IO ()-main = shaken noTest $ \args obj -> do-    want [obj "result.tar"]-    obj "result.tar" *> \out -> do-        contents <- readFileLines "Examples/Tar/list.txt"-        need contents-        system' "tar" $ ["-cf",out] ++ contents
− Examples/Tar/list.txt
@@ -1,3 +0,0 @@-Examples/Tar/Main.hs-Main.hs-Examples/Tar/list.txt
− Examples/Test/Basic.hs
@@ -1,61 +0,0 @@--module Examples.Test.Basic(main) where--import Development.Shake-import Examples.Util-import System.Directory---main = shaken test $ \args obj -> do-    want $ map obj args-    obj "AB.txt" *> \out -> do-        need [obj "A.txt", obj "B.txt"]-        text1 <- readFile' $ obj "A.txt"-        text2 <- readFile' $ obj "B.txt"-        writeFile' out $ text1 ++ text2--    obj "twice.txt" *> \out -> do-        let src = obj "once.txt"-        need [src, src]-        copyFile' src out--    obj "once.txt" *> \out -> do-        src <- readFile' $ obj "zero.txt"-        writeFile' out src---test build obj = do-    let f b pat file = assert (b == (pat ?== file)) $ show pat ++ " ?== " ++ show file ++ "\nEXPECTED: " ++ show b-    f True "//*.c" "foo/bar/baz.c"-    f True "*.c" "baz.c"-    f True "//*.c" "baz.c"-    f True "test.c" "test.c"-    f False "*.c" "foor/bar.c"-    f False "*/*.c" "foo/bar/baz.c"--    writeFile (obj "A.txt") "AAA"-    writeFile (obj "B.txt") "BBB"-    build ["AB.txt"]-    assertContents (obj "AB.txt") "AAABBB"-    sleepFileTime-    appendFile (obj "A.txt") "aaa"-    build ["AB.txt"]-    assertContents (obj "AB.txt") "AAAaaaBBB"--    writeFile (obj "zero.txt") "xxx"-    build ["twice.txt"]-    assertContents (obj "twice.txt") "xxx"-    sleepFileTime-    writeFile (obj "zero.txt") "yyy"-    build ["once.txt"]-    assertContents (obj "twice.txt") "xxx"-    assertContents (obj "once.txt") "yyy"-    sleepFileTime-    writeFile (obj "zero.txt") "zzz"-    build ["once.txt","twice.txt"]-    assertContents (obj "twice.txt") "zzz"-    assertContents (obj "once.txt") "zzz"--    removeFile $ obj "twice.txt"-    build ["twice.txt"]-    assertContents (obj "twice.txt") "zzz"
− Examples/Test/Directory.hs
@@ -1,37 +0,0 @@--module Examples.Test.Directory(main) where--import Development.Shake-import Examples.Util-import System.Directory(createDirectory)---main = shaken test $ \args obj -> do-    want $ map obj ["files.lst","dirs.lst","exist.lst"]-    obj "files.lst" *> \out -> do-        x <- getDirectoryFiles (obj "") "*.txt"-        writeFileLines out x-    obj "dirs.lst" *> \out -> do-        x <- getDirectoryDirs (obj "")-        writeFileLines out x-    obj "exist.lst" *> \out -> do-        xs <- readFileLines $ obj "files.lst"-        ys <- mapM (doesFileExist . obj) $ xs ++ map reverse xs-        writeFileLines out $ map show ys---test build obj = do-    build ["clean"]-    build []-    assertContents (obj "files.lst") $ unlines []-    assertContents (obj "dirs.lst") $ unlines []-    assertContents (obj "exist.lst") $ unlines []--    writeFile (obj "A.txt") ""-    writeFile (obj "B.txt") ""-    createDirectory (obj "Foo.txt")-    sleepFileTime-    build []-    assertContents (obj "files.lst") $ unlines ["A.txt","B.txt"]-    assertContents (obj "dirs.lst") $ unlines ["Foo.txt"]-    assertContents (obj "exist.lst") $ unlines ["True","True","False","False"]
− Examples/Test/Errors.hs
@@ -1,59 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}--module Examples.Test.Errors(main) where--import Development.Shake-import Examples.Util-import Control.Exception hiding (assert)-import Control.Monad-import Data.List-import System.Directory as IO---main = shaken test $ \args obj -> do-    want $ map obj args--    obj "norule" *> \_ ->-        need [obj "norule_isavailable"]--    obj "failcreate" *> \_ ->-        return ()--    obj "recursive" *> \out ->-        need [out]--    obj "systemcmd" *> \_ ->-        system' "random_missing_command" []--    obj "stack1" *> \_ -> need [obj "stack2"]-    obj "stack2" *> \_ -> need [obj "stack3"]-    obj "stack3" *> \_ -> error "crash"--    obj "staunch1" *> \out -> do-        liftIO $ sleep 0.1-        writeFile' out "test"-    obj "staunch2" *> \_ -> error "crash"---test build obj = do-    let crash args parts = do-            res <- try $ build args-            case res of-                Left (err :: SomeException) -> let s = show err in forM_ parts $ \p ->-                    assert (p `isInfixOf` s) $ "Incorrect exception, missing part:\nGOT: " ++ s ++ "\nWANTED: " ++ p-                Right _ -> error "Expected an exception but succeeded"--    crash ["norule"] ["norule_isavailable"]-    crash ["failcreate"] ["failcreate"]-    crash ["recursive"] ["recursive"]-    crash ["systemcmd"] ["systemcmd","random_missing_command"]-    crash ["stack1"] ["stack1","stack2","stack3","crash"]--    b <- IO.doesFileExist $ obj "staunch1"-    when b $ removeFile $ obj "staunch1"-    crash ["staunch1","staunch2","--threads2"] ["crash"]-    b <- IO.doesFileExist $ obj "staunch1"-    assert (not b) "File should not exist, should have crashed first"-    crash ["staunch1","staunch2","--threads2","--staunch"] ["crash"]-    b <- IO.doesFileExist $ obj "staunch1"-    assert b "File should exist, staunch should have let it be created"
− Examples/Test/FilePath.hs
@@ -1,17 +0,0 @@--module Examples.Test.FilePath(main) where--import Development.Shake.FilePath-import Examples.Util---main = shaken test $ \args obj -> return ()---test build obj = do-    normalise "neil//./test/moo/../bar/bob/../foo" === "neil/test/bar/foo"-    normalise "bar/foo" === "bar/foo"-    normalise "bar/foo/" === "bar/foo/"-    normalise "../../foo" === "../../foo"-    normalise "foo/bar/../../neil" === "neil"-    normalise "foo/../bar/../neil" === "neil"
− Examples/Test/Files.hs
@@ -1,41 +0,0 @@--module Examples.Test.Files(main) where--import Development.Shake-import Development.Shake.FilePattern-import Examples.Util-import Control.Monad-import Data.List---main = shaken test $ \args obj -> do-    want $ map obj ["even.txt","odd.txt"]--    let deps = map obj ["even.txt","odd.txt"]-    let def | "fun" `elem` args = (?>>) (\x -> if x `elem` deps then Just deps else Nothing)-            | otherwise = (*>>) deps--    def $ \[evens,odds] -> do-        src <- readFileLines $ obj "numbers.txt"-        let (es,os) = partition even $ map read src-        writeFileLines evens $ map show es-        writeFileLines odds  $ map show os---test build obj = do-    assert (compatible []) "compatible"-    assert (compatible ["//*a.txt","foo//a*.txt"]) "compatible"-    assert (not $ compatible ["//*a.txt","foo//a*.*txt"]) "compatible"-    extract "//*a.txt" "foo/bar/testa.txt" === ["foo/bar/","test"]-    extract "//*a.txt" "testa.txt" === ["","test"]-    extract "//*a*.txt" "testada.txt" === ["","test","da"]-    substitute ["","test","da"] "//*a*.txt" === "testada.txt"-    substitute  ["foo/bar/","test"] "//*a.txt" === "foo/bar/testa.txt"--    forM_ [[],["fun"]] $ \args -> do-        sleepFileTime-        let nums = unlines . map show-        writeFile (obj "numbers.txt") $ nums [1,2,4,5,2,3,1]-        build args-        assertContents (obj "even.txt") $ nums [2,4,2]-        assertContents (obj "odd.txt" ) $ nums [1,5,3,1]
− Examples/Test/Pool.hs
@@ -1,80 +0,0 @@--module Examples.Test.Pool(main) where--import Examples.Util-import Development.Shake.Pool--import Control.Concurrent-import Control.Exception hiding (assert)-import Control.Monad---main = shaken test $ \args obj -> return ()---test build obj = do-    let wait = sleep 0.01--    -- check that it aims for exactly the limit-    forM_ [1..6] $ \n -> do-        var <- newMVar (0,0) -- (maximum, current)-        runPool n $ \pool ->-            forM_ [1..5] $ \i ->-                addPool pool $ do-                    modifyMVar_ var $ \(mx,now) -> return (max (now+1) mx, now+1)-                    wait-                    modifyMVar_ var $ \(mx,now) -> return (mx,now-1)-        res <- takeMVar var-        res === (min n 5, 0)--    -- check that exceptions are immediate-    self <- myThreadId-    handle (\(ErrorCall msg) -> msg === "pass") $-        runPool 3 $ \pool -> do-            addPool pool $ do-                wait-                error "pass"-            addPool pool $ do-                wait >> wait-                throwTo self $ ErrorCall "fail" -    wait >> wait -- give chance for a delayed exception--    -- check blocking works-    done <- newMVar False-    runPool 1 $ \pool -> do-        var <- newEmptyMVar-        addPool pool $ do-            addPool pool $ do-                wait-                putMVar var ()-            blockPool pool $ takeMVar var-            modifyMVar_ done $ const $ return True-    done <- readMVar done-    assert done "Blocking"--    -- check someone spawned when at zero todo still gets run-    done <- newMVar False-    runPool 1 $ \pool ->-        addPool pool $ do-            wait-            addPool pool $ do-                wait-                modifyMVar_ done $ const $ return True-    done <- readMVar done-    assert done "Waiting on someone"--    -- check that killing a thread pool stops the tasks, bug 545-    thread <- newEmptyMVar-    done <- newEmptyMVar-    res <- newMVar True-    t <- forkIO $ finally (putMVar done ()) $ runPool 1 $ \pool ->-        addPool pool $ do-            t <- takeMVar thread-            killThread t-            wait -- allow the thread to die first-            modifyMVar_ res (const $ return False)-    putMVar thread t-    takeMVar done-    wait >> wait >> wait -- allow the bad thread to continue-    res <- readMVar res-    assert res "Early termination"
− Examples/Test/Random.hs
@@ -1,127 +0,0 @@--module Examples.Test.Random(main) where--import Development.Shake-import Examples.Util-import Control.Exception-import Control.Monad-import Data.List-import System.Random-import qualified Data.ByteString.Char8 as BS---inputRange = [1..10]--data Value = Single Int | Multiple [[Value]]-    deriving (Read,Show,Eq)--data Source = Input Int | Output Int | Bang-    deriving (Read,Show)--data Logic = Logic Int [[Source]]-           | Want [Int]-    deriving (Read,Show)---main = shaken test $ \args obj -> do-    let toFile (Input i) = obj $ "input-" ++ show i ++ ".txt"-        toFile (Output i) = obj $ "output-" ++ show i ++ ".txt"-        toFile Bang = error "BANG"--    let randomSleep = liftIO $ do-            i <- randomRIO (0, 25)-            sleep $ fromInteger i / 100--    forM_ (map read args) $ \x -> case x of-        Want xs -> want $ map (toFile . Output) xs-        Logic out srcs -> toFile (Output out) *> \out -> do-            res <- fmap (show . Multiple) $ forM srcs $ \src -> do-                randomSleep-                need $ map toFile src-                mapM (liftIO . fmap read . readFileStrict . toFile) src-            randomSleep-            writeFileChanged out res---test build obj = forM_ [1..] $ \count -> do-    putStrLn $ "* PERFORMING RANDOM TEST " ++ show count-    build ["clean"]-    build [] -- to create the directory-    forM_ inputRange $ \i ->-        writeFile (obj $ "input-" ++ show i ++ ".txt") $ show $ Single i-    logic <- randomLogic-    runLogic [] logic-    chng <- filterM (const randomIO) inputRange   -    forM_ chng $ \i ->-        writeFile (obj $ "input-" ++ show i ++ ".txt") $ show $ Single $ negate i-    runLogic chng logic-    forM_ inputRange $ \i ->-        writeFile (obj $ "input-" ++ show i ++ ".txt") $ show $ Single i-    logicBang <- addBang =<< addBang logic-    j <- randomRIO (1::Int,8)-    res <- try $ build $ ("--threads" ++ show j) : map show (logicBang ++ [Want [i | Logic i _ <- logicBang]])-    case res of-        Left err-            | "BANG" `isInfixOf` show (err :: SomeException) -> return () -- error I expected-            | otherwise -> error $ "UNEXPECTED ERROR: " ++ show err-        _ -> return () -- occasionally we only put BANG in places with no dependenies that don't get rebuilt-    runLogic [] $ logic ++ [Want [i | Logic i _ <- logic]]-    where-        runLogic :: [Int] -> [Logic] -> IO ()-        runLogic negated xs = do-            let poss = [i | Logic i _ <- xs]-            i <- randomRIO (0, 7)-            wants <- replicateM i $ do-                i <- randomRIO (0, 5)-                replicateM i $ randomElem poss-            sleepFileTime-            j <- randomRIO (1::Int,8)-            build $ ("--threads" ++ show j) : map show (xs ++ map Want wants)--            let value i = case [ys | Logic j ys <- xs, j == i] of-                    [ys] -> Multiple $ flip map ys $ map $ \i -> case i of-                        Input i -> Single $ if i `elem` negated then negate i else i-                        Output i -> value i-            forM_ (concat wants) $ \i -> do-                let wanted = value i-                got <- fmap read $ readFileStrict $ obj $ "output-" ++ show i ++ ".txt"-                when (wanted /= got) $-                    error $ "INCORRECT VALUE for " ++ show i---addBang :: [Logic] -> IO [Logic]-addBang xs = do-    i <- randomRIO (0, length xs - 1)-    let (before,now:after) = splitAt i xs-    now <- f now-    return $ before ++ now : after-    where-        f (Logic log xs) = do-            i <- randomRIO (0, length xs)-            let (before,after) = splitAt i xs-            return $ Logic log $ before ++ [Bang] : after---randomLogic :: IO [Logic] -- only Logic constructors-randomLogic = do-    rules <- randomRIO (1,100)-    f rules $ map Input inputRange-    where-        f 0 avail = return []-        f i avail = do-            needs <- randomRIO (0,3)-            xs <- replicateM needs $ do-                ns <- randomRIO (0,3)-                replicateM ns $ randomElem avail-            let r = Logic i xs-            fmap (r:) $ f (i-1) (Output i:avail)---randomElem :: [a] -> IO a-randomElem xs = do-    i <- randomRIO (0, length xs - 1)-    return $ xs !! i---readFileStrict :: FilePath -> IO String-readFileStrict = fmap BS.unpack . BS.readFile
− Examples/Test/Resources.hs
@@ -1,31 +0,0 @@--module Examples.Test.Resources(main) where--import Development.Shake-import Examples.Util-import Control.Monad-import Data.IORef---main = do-    let cap = 2--    ref <- newIORef 0-    res <- newResource "test" cap-    shaken test $ \args obj -> do-        want $ map obj ["file1.txt","file2.txt","file3.txt","file4.txt"]-        obj "*.txt" *> \out ->-            withResource res 1 $ do-                old <- liftIO $ atomicModifyIORef ref $ \i -> (i+1,i)-                when (old >= cap) $ error "Too many resources in use at one time"-                liftIO $ sleep 0.1-                liftIO $ atomicModifyIORef ref $ \i -> (i-1,i)-                writeFile' out ""--test build obj = do-    build ["clean"]-    build ["--threads2"]-    build ["clean"]-    build ["--threads4"]-    build ["clean"]-    build ["--threads10"]
− Examples/Util.hs
@@ -1,134 +0,0 @@--module Examples.Util(module Examples.Util) where--import Development.Shake-import Development.Shake.FilePath--import Control.Concurrent-import Control.Monad-import Data.List-import System.Directory as IO-import System.Environment-import System.Random---shaken-    :: (([String] -> IO ()) -> (String -> String) -> IO ())-    -> ([String] -> (String -> String) -> Rules ())-    -> IO ()-shaken test rules = do-    name:args <- getArgs-    putStrLn $ "## BUILD " ++ unwords (name:args)-    let out = "output/" ++ name ++ "/"-    createDirectoryIfMissing True out-    case args of-        "test":_ -> do-            putStrLn $ "## TESTING " ++ name-            test (\args -> withArgs (name:args) $ shaken test rules) (out++)-            putStrLn $ "## FINISHED TESTING " ++ name-        "clean":_ -> removeDirectoryRecursive out-{--        "lint":args -> do-            let dbfile = out ++ ".database"-                tempfile = "output/" ++ name ++ ".database"-            b <- IO.doesFileExist dbfile-            when b $ renameFile dbfile tempfile-            removeDirectoryRecursive out-            createDirectoryIfMissing True out-            when b $ renameFile tempfile dbfile-            shake shakeOptions{shakeFiles=out, shakeLint=True} $ rules args (out++)--}--        "perturb":args -> forever $ do-            del <- removeFilesRandom out-            threads <- randomRIO (1,4)-            putStrLn $ "## TESTING PERTURBATION (" ++ show del ++ " files, " ++ show threads ++ " threads)"-            shake shakeOptions{shakeFiles=out, shakeThreads=threads, shakeVerbosity=Quiet} $ rules args (out++)--        args -> do-            (flags,args) <- return $ partition ("-" `isPrefixOf`) args-            let f o x = let x2 = dropWhile (== '-') x in case lookup x2 flagList of-                    Just op -> op o-                    Nothing | "threads" `isPrefixOf` x2 -> o{shakeThreads=read $ drop 7 x2}-                            | otherwise -> error $ "Don't know how to deal with flag: " ++ x-            let opts = foldl' f shakeOptions{shakeFiles=out, shakeReport=Just $ "output/" ++ name ++ "/report.html"} flags-            shake opts $ rules args (out++)---flags :: [String]-flags = "threads#" : map fst flagList---flagList :: [(String, ShakeOptions -> ShakeOptions)]-flagList = let (*) = (,) in-    ["no-dump" * \o -> o{shakeReport=Nothing}-    ,"silent" * \o -> o{shakeVerbosity=Silent}-    ,"quiet" * \o -> o{shakeVerbosity=Quiet}-    ,"normal" * \o -> o{shakeVerbosity=Normal}-    ,"loud" * \o -> o{shakeVerbosity=Loud}-    ,"diagnostic" * \o -> o{shakeVerbosity=Diagnostic}-    ,"staunch" * \o -> o{shakeStaunch=True}-    ,"lint" * \o -> o{shakeLint=True}-    ]---unobj :: FilePath -> FilePath-unobj = dropDirectory1 . dropDirectory1--assert :: Bool -> String -> IO ()-assert b msg = unless b $ error $ "ASSERTION FAILED: " ++ msg---(===) :: (Show a, Eq a) => a -> a -> IO ()-a === b = assert (a == b) $ "failed in ===\nLHS: " ++ show a ++ "\nRHS: " ++ show b---assertContents :: FilePath -> String -> IO ()-assertContents file want = do-    got <- readFile file-    assert (want == got) $ "File contents are wrong: " ++ file ++ "\nWANT: " ++ want ++ "\nGOT: " ++ got---noTest :: ([String] -> IO ()) -> (String -> String) -> IO ()-noTest build obj = do-    build []-    build []---sleep :: Double -> IO ()-sleep x = threadDelay $ ceiling $ x * 1000000----- | Sleep long enough for the modification time resolution to catch up-sleepFileTime :: IO ()-sleepFileTime = sleep 1---removeFilesRandom :: FilePath -> IO Int-removeFilesRandom x = do-    files <- getDirectoryContentsRecursive x-    n <- randomRIO (0,length files)-    rs <- replicateM (length files) (randomIO :: IO Double)-    mapM_ (removeFile . snd) $ sort $ zip rs files-    return n---getDirectoryContentsRecursive :: FilePath -> IO [FilePath]-getDirectoryContentsRecursive dir = do-    xs <- IO.getDirectoryContents dir-    (dirs,files) <- partitionM doesDirectoryExist [dir </> x | x <- xs, not $ isBadDir x]-    rest <- concatMapM getDirectoryContentsRecursive dirs-    return $ files++rest-    where-        isBadDir x = "." `isPrefixOf` x || "_" `isPrefixOf` x--partitionM :: Monad m => (a -> m Bool) -> [a] -> m ([a], [a])-partitionM f [] = return ([], [])-partitionM f (x:xs) = do-    res <- f x-    (as,bs) <- partitionM f xs-    return ([x|res]++as, [x|not res]++bs)--concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]-concatMapM f = liftM concat . mapM f-
LICENSE view
@@ -1,4 +1,4 @@-Copyright Neil Mitchell 2011-2012.+Copyright Neil Mitchell 2011-2026. All rights reserved.  Redistribution and use in source and binary forms, with or without
− Main.hs
@@ -1,54 +0,0 @@-module Main where--import Data.Maybe-import System.Environment--import Examples.Util(flags)-import qualified Examples.Tar.Main as Tar-import qualified Examples.Self.Main as Self-import qualified Examples.C.Main as C-import qualified Examples.Test.Basic as Basic-import qualified Examples.Test.Directory as Directory-import qualified Examples.Test.Errors as Errors-import qualified Examples.Test.Files as Files-import qualified Examples.Test.FilePath as FilePath-import qualified Examples.Test.Pool as Pool-import qualified Examples.Test.Random as Random-import qualified Examples.Test.Resources as Resources---fakes = ["clean" * clean, "test" * test]-    where (*) = (,)--mains = ["tar" * Tar.main, "self" * Self.main, "c" * C.main-        ,"basic" * Basic.main, "directory" * Directory.main, "errors" * Errors.main-        ,"filepath" * FilePath.main, "files" * Files.main, "pool" * Pool.main, "random" * Random.main-        ,"resources" * Resources.main]-    where (*) = (,)---main :: IO ()-main = do-    xs <- getArgs-    case flip lookup (fakes ++ mains) =<< listToMaybe xs of-        Nothing -> putStrLn $ unlines-            ["Welcome to the Shake demo"-            ,""-            ,unwords $ "Modes:" : map fst fakes-            ,unwords $ "Demos:" : map fst mains-            ,unwords $ "Flags:" : flags-            ,""-            ,"As an example, try:"-            ,""-            ,"  main self --threads2 --loud"-            ,""-            ,"Which will build Shake, using Shake, on 2 threads."]-        Just main -> main---clean :: IO ()-clean = sequence_ [withArgs [name,"clean"] main | (name,main) <- mains]---test :: IO ()-test = sequence_ [withArgs [name,"test"] main | (name,main) <- mains, name /= "random"]
+ README.md view
@@ -0,0 +1,19 @@+# Shake [![Hackage version](https://img.shields.io/hackage/v/shake.svg?label=Hackage)](https://hackage.haskell.org/package/shake) [![Stackage version](https://www.stackage.org/package/shake/badge/nightly?label=Stackage)](https://www.stackage.org/package/shake) [![Build status](https://img.shields.io/github/actions/workflow/status/ndmitchell/shake/ci.yml?branch=master)](https://github.com/ndmitchell/shake/actions)++Shake is a tool for writing build systems - an alternative to make, Scons, Ant etc. Shake has been used commercially for over five years, running thousands of builds per day. The website for Shake users is at [shakebuild.com](https://shakebuild.com).++#### Documentation++* **Why use Shake?** Shake lets you write large robust build systems, which deal properly with generated source files and run quickly. If you are writing a custom build system of any moderate size (more than a few rules) you should use Shake. The advantages over other build systems are detailed in the document [Why choose Shake?](https://shakebuild.com/why).+* **How do I use Shake?** Shake is a Haskell library that you use to define your rules. The [Shake manual](https://shakebuild.com/manual) provides a walk through of a small but realistic example, assuming no Haskell knowledge.+* [Generated documentation](https://hackage.haskell.org/packages/archive/shake/latest/doc/html/Development-Shake.html) for all functions, includes lots of examples.+* [Blog posts](https://neilmitchell.blogspot.co.uk/search/label/shake) detailing ongoing development work.+* [Academic paper](https://ndmitchell.com/downloads/paper-shake_before_building-10_sep_2012.pdf) on the underlying principles behind Shake.++#### Other links++* [Download the Haskell package](https://hackage.haskell.org/package/shake) from Hackage and install it using Cabal.+* [Mailing list](https://groups.google.com/forum/?fromgroups#!forum/shake-build-system) for any questions/bugs/thoughts on Shake. If you need more information and aren't sure where to start, use the mailing list.+* [Questions](https://stackoverflow.com/questions/tagged/shake-build-system) can be asked on StackOverflow with the tag `shake-build-system`.++Is your company using Shake? Write something public (even just a [tweet to `@ndm_haskell`](https://twitter.com/ndm_haskell)) and I'll include a link [on the website](https://shakebuild.com/#who-uses-shake).
+ docs/Manual.md view
@@ -0,0 +1,454 @@+# Shake Manual++_See also: [Shake links](https://github.com/ndmitchell/shake#readme); [Why choose Shake](Why.md#readme); [Function documentation](https://hackage.haskell.org/packages/archive/shake/latest/doc/html/Development-Shake.html)_++Shake is a Haskell library for writing build systems -- designed as a replacement for `make`. This document describes how to get started with Shake, assuming no prior Haskell knowledge. First, let's take a look at a Shake build system:++    import Development.Shake+    import Development.Shake.Command+    import Development.Shake.FilePath+    import Development.Shake.Util++    main :: IO ()+    main = shakeArgs shakeOptions{shakeFiles="_build"} $ do+        want ["_build/run" <.> exe]++        phony "clean" $ do+            putInfo "Cleaning files in _build"+            removeFilesAfter "_build" ["//*"]++        "_build/run" <.> exe %> \out -> do+            cs <- getDirectoryFiles "" ["//*.c"]+            let os = ["_build" </> c -<.> "o" | c <- cs]+            need os+            cmd_ "gcc -o" [out] os++        "_build//*.o" %> \out -> do+            let c = dropDirectory1 $ out -<.> "c"+            let m = out -<.> "m"+            cmd_ "gcc -c" [c] "-o" [out] "-MMD -MF" [m]+            neededMakefileDependencies m++This build system builds the executable `_build/run` from all C source files in the current directory. It will rebuild if you add/remove any C files to the directory, if the C files themselves change, or if any headers used by the C files change. All generated files are placed in `_build`, and a `clean` command is provided that will wipe all the generated files. In the rest of this manual we'll explain how the above code works and how to extend it.++#### Running this example++To run the example above:++1. Install the [Haskell Stack](https://haskellstack.org/), which provides a Haskell compiler and package manager.+2. Type `stack install shake`, to build and install Shake and all its dependencies.+3. Type `stack exec -- shake --demo`, which will create a directory containing a sample project, the above Shake script (named `Shakefile.hs`), and execute it (which can be done by `runhaskell Shakefile.hs`). For more details see a [trace of `shake --demo`](Demo.md).++## Basic syntax++This section explains enough syntax to write a basic Shake build script.++#### Boilerplate++The build system above starts with the following boilerplate:++<pre>+import Development.Shake+import Development.Shake.Command+import Development.Shake.FilePath+import Development.Shake.Util+&#32;+main :: IO ()+main = shakeArgs shakeOptions{shakeFiles="_build"} $ do+    <i>build rules</i>+</pre>++All the interesting build-specific code is placed under <tt><i>build rules</i></tt>. Many build systems will be able to reuse that boilerplate unmodified.++#### Defining targets++A target is a file we want the build system to produce (typically executable files). For example, if we want to produce the file `manual/examples.txt` we can write:++    want ["manual/examples.txt"]++The `want` function takes a list of strings. In Shake lists are written `[item1,item2,item2]` and strings are written `"contents of a string"`. Special characters in strings can be escaped using `\` (e.g. `"\n"` for newline) and directory separators are always written `/`, even on Windows.++Most files have the same name on all platforms, but executable files on Windows usually have the `.exe` extension, while on POSIX they have no extension. When writing cross-platform build systems (like the initial example), we can write:++    want ["_build/run" <.> exe]++The `<.>` function adds an extension to a file path, and the built-in `exe` variable evaluates to `"exe"` on Windows and `""` otherwise.++#### Defining rules++A rule describes the steps required to build a file. A rule has two components, a <tt><i>pattern</i></tt> and some <tt><i>actions</i></tt>:++<pre>+<i>pattern</i> %&gt; \out -> do+    <i>actions</i>+</pre>++The <tt><i>pattern</i></tt> is a string saying which files this rule can build. It may be a specific file (e.g.  `"manual/examples.txt" %> ...`) or may use wildcards:++* The `*` wildcard matches anything apart from a directory separator. For example `"manual/*.txt"` would define a rule for any `.txt` file in the `manual` directory, including `manual/examples.txt`, but would not match `manual/examples.zip`, `examples.txt` or `manual/docs/examples.txt`.+* The `//` wildcard matches any number of complete path components. For example `//*.txt` would define a rule for any `.txt` file, including `manual/examples.txt`. As another example, `manual//examples.txt` would match any file named `examples.txt` inside `manual`, including both `manual/examples.txt` and `manual/docs/examples.txt`.++It is an error for multiple patterns to match a file being built, so you should keep patterns minimal. Looking at the two rules in the initial example:++    "_build/run" <.> exe %> ...+    "_build//*.o" %> ...++The first matches only the `run` executable, using `<.> exe` to ensure the executable is correctly named on all platforms. The second matches any `.o` file anywhere under `_build`. As examples, `_build/main.o` and `_build/foo/bar.o` both match while `main.o` and `_build/main.txt` do not.++Lots of compilers produce `.o` files, so if you are combining two different languages, say C and Haskell, use the extension `.c.o` and `.hs.o` to avoid overlapping rules.++The <tt><i>actions</i></tt> are a list of steps to perform and are listed one per line, indented beneath the rule. Actions both express dependencies (say what this rule uses) and run commands (actually generate the file). During the action the `out` variable is bound to the file that is being produced.++#### A simple rule++Let's look at a simple example of a rule:++    "*.rot13" %> \out -> do+        let src = out -<.> "txt"+        need [src]+        cmd_ "rot13" src "-o" out++This rule can build any `.rot13` file. Imagine we are building `"file.rot13"`, it proceeds by:++* Using `let` to define a local variable `src`, using the `-<.>` extension replacement method, which removes the extension from a file and adds a new extension. When `out` is `"file.rot13"` the variable `src` will become `file.txt`.+* Using `need` to introduce a dependency on the `src` file, ensuring that if `src` changes then `out` will be rebuilt and that `src` will be up-to-date before any further commands are run.+* Using `cmd_` to run the command line `rot13 file.txt -o file.rot13`, which should read `file.txt` and write out `file.rot13` being the ROT13 encoding of the file.++Many rules follow this pattern -- calculate some local variables, `need` some dependencies, then use `cmd_` to perform some actions. We now discuss each of the three statements.++#### Local variables++Local variables can be defined as:++<pre>+let <i>variable</i> = <i>expression</i>+</pre>++Where <tt><i>variable</i></tt> is a name consisting of letters, numbers and underscores (a-z, A-Z, 0-9 and \_). All variables _must_ start with a lower-case letter.++An <tt><i>expression</i></tt> is any combination of variables and function calls, for example `out -<.> "txt"`. A list of some common functions is discussed later.++Variables are evaluated by substituting the <tt><i>expression</i></tt> everywhere the <tt><i>variable</i></tt> is used. In the simple example we could have equivalently written:++    "*.rot13" %> \out -> do+        need [out -<.> "txt"]+        cmd_ "rot13" (out -<.> "txt") "-o" out++Variables are local to the rule they are defined in, cannot be modified, and should not be defined multiple times within a single rule.++#### File dependencies++You can express a dependency on a file with:++    need ["file.src"]++To depend on multiple files you can write:++    need ["file.1","file.2"]++Or alternatively:++    need ["file.1"]+    need ["file.2"]++It is preferable to use fewer calls to `need`, if possible, as multiple files required by a `need` can be built in parallel.++#### Running external commands++The `cmd_` function allows you to call system commands, e.g. `gcc`. Taking the initial example, we see:++    cmd_ "gcc -o" [out] os++After substituting `out` (a string variable) and `os` (a list of strings variable) we might get:++    cmd_ "gcc -o" ["_make/run"] ["_build/main.o","_build/constants.o"]++The `cmd_` function takes any number of space-separated expressions. Each expression can be either a string (which is treated as a space-separated list of arguments) or a list of strings (which is treated as a direct list of arguments).  Therefore the above command line is equivalent to either of:++    cmd_ "gcc -o _make/run _build/main.o _build/constants.o"+    cmd_ ["gcc","-o","_make/run","_build/main.o","_build/constants.o"]++To properly handle unknown string variables it is recommended to enclose them in a list, e.g. `[out]`, so that even if `out` contains a space it will be treated as a single argument.++The `cmd_` function as presented here will fail if the system command returns a non-zero exit code, but see later for how to treat failing commands differently.++#### Filepath manipulation functions++Shake provides a complete library of filepath manipulation functions (see the [docs for `Development.Shake.FilePath`](https://hackage.haskell.org/package/shake/docs/Development-Shake-FilePath.html)), but the most common are:++* `str1 </> str2` -- add the path components together with a slash, e.g. `"_build" </> "main.o"` equals `"_build/main.o"`.+* `str1 <.> str2` -- add an extension, e.g. `"main" <.> "o"` equals `"main.o"`.+* `str1 ++ str2` -- append two strings together, e.g. `"hello" ++ "world"` equals `"helloworld"`.+* `str1 -<.> str2` -- replace an extension, e.g. `"main.c" -<.> "o"` equals `"main.o"`.+* `dropExtension str` -- drop the final extension of a filepath if it has one, e.g. `dropExtension "main.o"` equals `"main"`, while `dropExtension "main"` equals `"main"`.+* `takeFileName str` -- drop the path component, e.g. `takeFileName "_build/src/main.o"` equals `"main.o"`.+* `dropDirectory1 str` -- drop the first path component, e.g. `dropDirectory1 "_build/src/main.o"` equals `"src/main.o"`.++## Advanced Syntax++The following section covers more advanced operations that are necessary for moderately complex build systems, but not simple ones.++#### Directory listing dependencies++The function `getDirectoryFiles` can retrieve a list of files within a directory:++    files <- getDirectoryFiles "" ["//*.c"]++After this operation `files` will be a variable containing all the files matching the pattern `"//*.c"` (those with the extension `.c`) starting at the directory `""` (the current directory). To obtain all `.c` and `.cpp` files in the src directory we can write:++    files <- getDirectoryFiles "src" ["//*.c","//*.cpp"]++The `getDirectoryFiles` operation is tracked by the build system, so if the files in a directory change the rule will rebuild in the next run. You should only use `getDirectoryFiles` on source files, not files that are generated by the build system, otherwise the results will change while you are running the build and the build may be inconsistent.++#### List manipulations++Many functions work with lists of values. The simplest operation on lists is to join two lists together, which we do with `++`. For example, `["main.c"] ++ ["constants.c"]` equals `["main.c", "constants.c"]`.++Using a _list comprehension_ we can produce new lists, apply functions to the elements and filtering them. As an example:++    ["_build" </> x -<.> "o" | x <- inputs]++This expression grabs each element from `inputs` and names it `x` (the `x <- inputs`, pronounced "`x` is drawn from `inputs`"), then applies the expression  `"_build" </> x -<.> "o"` to each element. If we start with the list `["main.c","constants.c"]`, we would end up with `["_build/main.o", "_build/constants.o"]`.++List expressions also allow us to filter the list, for example we could know that the file `"evil.c"` is in the directory, but should not be compiled. We can extend that to:++    ["_build" </> x -<.> "o" | x <- inputs, x /= "evil.c"]++The `/=` operator checks for inequality, and any predicate after the drawn from is used to first restrict which elements of the list are available.++#### Using `gcc` to collect headers++One common problem when building `.c` files is tracking down which headers they transitively import, and thus must be added as a dependency. We can solve this problem by asking `gcc` to create a file while building that contains a list of all the imports. If we run:++    gcc -c main.c -o main.o -MMD -MF main.m++That will compile `main.c` to `main.o`, and also produce a file `main.m` containing the dependencies. To add these dependencies as dependencies of this rule we can call:++    neededMakefileDependencies "main.m"++Now, if either `main.c` or any headers transitively imported by `main.c` change, the file will be rebuilt. In the initial example the complete rule is:++    "_build//*.o" %> \out -> do+        let c = dropDirectory1 $ out -<.> "c"+        let m = out -<.> "m"+        cmd_ "gcc -c" [c] "-o" [out] "-MMD -MF" [m]+        neededMakefileDependencies m++We first compute the source file `c` (e.g. `"main.c"`) that is associated with the `out` file (e.g. `"_build/main.o"`). We then compute a temporary file `m` to write the dependencies to (e.g. `"_build/main.m"`). We then call `gcc` using the `-MMD -MF` flags and then finally call `neededMakefileDependencies`.++#### Top-level variables++Variables local to a rule are defined using `let`, but you can also define top-level variables. Top-level variables are defined before the `main` call, for example:++    buildDir = "_build"++You can now use `buildDir` in place of `"_build"` throughout. You can also define parametrised variables (functions) by adding argument names:++    buildDir x = "_build" </> x++We can now write:++    buildDir ("run" <.> exe) %> \out -> do+        ...++All top-level variables and functions can be thought of as being expanded wherever they are used, although in practice may have their evaluation shared.++#### A clean command++A standard clean command is defined as:++    phony "clean" $ do+        putInfo "Cleaning files in _build"+        removeFilesAfter "_build" ["//*"]++Running the build system with the `clean` argument, e.g. `runhaskell Shakefile.hs clean` will remove all files under the `_build` directory. This clean command is formed from two separate pieces. Firstly, we can define `phony` commands as:++<pre>+phony "<i>name</i>" $ do+    <i>actions</i>+</pre>++Where <tt><i>name</i></tt> is the name used on the command line to invoke the actions, and <tt><i>actions</i></tt> are the list of things to do in response. These names are not dependency tracked and are run afresh each time they are requested.++The <tt><i>actions</i></tt> can be any standard build actions, although for a `clean` rule, `removeFilesAfter` is typical. This function waits until after any files have finished building (which will be none, if you do `runhaskell Shakefile.hs clean`) then deletes all files matching `//*` in the `_build` directory. The `putInfo` function writes out a message to the console, as long as `--quiet` was not passed.++## Running++This section covers how to run the build system you have written.++#### Compiling the build system++As shown before, we can use `runhaskell Shakefile.hs` to execute our build system, but doing so causes the build script to be compiled afresh each time. A more common approach is to add a shell script that compiles the build system and runs it. In the example directory you will find `build.sh` (Linux) and `build.bat` (Windows), both of which execute the same interesting commands. Looking at `build.sh`:++    #!/bin/sh+    mkdir -p _shake+    ghc --make Shakefile.hs -rtsopts -threaded -with-rtsopts=-I0 -outputdir=_shake -o _shake/build && _shake/build "$@"++This script creates a folder named `_shake` for the build system objects to live in, then runs `ghc --make Shakefile.hs` to produce `_shake/build`, then executes `_shake/build` with all arguments it was given. The `-with-rtsopts` flag instructs the Haskell compiler to disable "idle garbage collection", making more CPU available for the commands you are running, as [explained here](https://stackoverflow.com/questions/34588057/why-does-shake-recommend-disabling-idle-garbage-collection/).++Now you can run a build by typing `stack exec ./build.sh` on Linux, or `stack exec build.bat` on Windows. On Linux you may want to alias `build` to `stack exec ./build.sh`. For the rest of this document we will assume `build` runs the build system.++_Warning:_ You should not use the `-threaded` for GHC 7.6 or below because of a [GHC bug](https://ghc.haskell.org/trac/ghc/ticket/7646). If you do turn on `-threaded`, you should include `-qg` in `-with-rtsopts`.++#### Command line flags++The initial example build system supports a number of command line flags, including:++* `build` will compile all files required by `want`.+* `build _build/main.o` will compile enough to create `_build/main.o`, ignoring all `want` requirements.+* `build clean` will delete the contents of `_build`, because of our `phony` command.+* `build --help` will list out all flags supported by the build system, currently 36 flags. Most flags supported by `make` are also supported by Shake based build systems.+* `build -j8` will compile up to 8 rules simultaneously, by default Shake uses 1 processor.++Most flags can also be set within the program by modifying the `shakeOptions` value. As an example, `build --metadata=_metadata` causes all Shake metadata files to be stored with names such as `_metadata/.shake.database`. Alternatively we can write `shakeOptions{shakeFiles="_metadata"}` instead of our existing `shakeFiles="_build"`. Values passed on the command line take preference over those given by `shakeOptions`. Multiple overrides can be given to `shakeOptions` by separating them with a comma, for example `shakeOptions{shakeFiles="_build", shakeThreads=8}`.++<span class="target" id="progress"></span>++#### Progress prediction++One useful feature of Shake is that it can predict the remaining build time, based on how long previous builds have taken. The number is only a prediction, but it does take account of which files require rebuilding, how fast your machine is currently running, parallelism settings etc. You can display progress messages in the titlebar of a Window by either:++* Running `build --progress`+* Setting `shakeOptions{shakeProgress = progressSimple}`++The progress message will be displayed in the titlebar of the window, for example `3m12s (82%)` to indicate that the build is 82% complete and is predicted to take a further 3 minutes and 12 seconds. If you are running Windows 7 or higher and place the [`shake-progress`](https://github.com/ndmitchell/shake/releases/tag/shake-progress-1) utility somewhere on your `%PATH%` then the progress will also be displayed in the taskbar progress indicator:++![](shake-progress.png)++Progress prediction is likely to be relatively poor during the first build and after running `build clean`, as then Shake has no information about the predicted execution time for each rule. To rebuild from scratch without running clean (because you really want to see the progress bar!) you can use the argument `--always-make`, which assumes all rules need rerunning.++<span class="target" id="lint"></span>++#### Lint++Shake features a built in "lint" feature to check the build system is well formed. To run use `build --lint`. You are likely to catch more lint violations if you first `build clean`. Sadly, lint does _not_ catch missing dependencies. However, it does catch:++* Changing the current directory, typically with `setCurrentDirectory`. You should never change the current directory within the build system as multiple rules running at the same time share the current directory. You can still run `cmd_` calls in different directories using the `Cwd` argument.+* Outputs that change after Shake has built them. The usual cause of this error is if the rule for `foo` also writes to the file `bar`, despite `bar` having a different rule producing it.++There is a performance penalty for building with `--lint`, but it is typically small. For more details see [this page on all the Lint options](Lint.md).++<span class="target" id="profiling"></span>++#### Profiling and optimisation++Shake features an advanced profiling feature. To build with profiling run `build --report`, which will generate an interactive HTML profile named `report.html`. This report lets you examine what happened in that run, what takes most time to run, what rules depend on what etc. For a full explanation of how to profile and optimise a build system, including getting accurate timings and using Haskell profiling, see [the profiling and optimisation page](Profiling.md).++#### Tracing and debugging++To debug a build system there are a variety of techniques that can be used:++* Run with lint checking enabled (`--lint`), which may spot and describe the problem for you.+* Run in single-threaded mode (`-j1`) to make any output clearer by not interleaving commands.+* By default a Shake build system prints out a message every time it runs a command. Use verbose mode (`--verbose`) to print more information to the screen, such as which rule is being run. Additional `--verbose` flags increase the verbosity. Three verbosity flags produce output intended for someone debugging the Shake library itself, rather than a build system based on it.+* To raise a build error call `error "error message"`. Shake will abort, showing the error message.+* To output additional information use `putInfo "output message"`. This message will be printed to the console when it is reached.+* To show additional information with either `error` or `putInfo`, use `error $ show ("message", myVariable)`. This allows you to show any local variables.++## Extensions++This section details a number of build system features that are useful in some build systems, but not the initial example, and not most average build systems.++#### Advanced `cmd` usage++The `cmd_` has a related function `cmd` that can also obtain the stdout and stderr streams, along with the  exit code. As an example:++    (Exit code, Stdout out, Stderr err) <- cmd "gcc --version"++Now the variable `code` is bound to the exit code, while `out` and `err` are bound to the stdout and stderr streams. If `ExitCode` is not requested then any non-zero return value will raise an error.++Both `cmd_` and `cmd` also take additional parameters to control how the command is run. As an example:++    cmd_ Shell (Cwd "temp") "pwd"++This runs the `pwd` command through the system shell, after first changing to the `temp` directory.++#### Dependencies on environment variables++You can use tracked dependencies on environment variables using the `getEnv` function. As an example:++    link <- getEnv "C_LINK_FLAGS"+    let linkFlags = fromMaybe "" link+    cmd_ "gcc -o" [output] inputs linkFlags++This example gets the `$C_LINK_FLAGS` environment variable (which is `Maybe String`, namely a `String` that might be missing), then using `fromMaybe` defines a local variable `linkFlags` that is the empty string when `$C_LINK_FLAGS` is not set. It then passes these flags to `gcc`.++If the `$C_LINK_FLAGS` environment variable changes then this rule will rebuild.++#### Dependencies on extra information++Using Shake we can depend on arbitrary extra information, such as the version of `gcc`, allowing us to automatically rebuild all C files when a different compiler is placed on the path. To track the version, we can define a rule for the file `gcc.version` which changes only when `gcc --version` changes:++    "gcc.version" %> \out -> do+        alwaysRerun+        Stdout stdout <- cmd "gcc --version"+        writeFileChanged out stdout++This rule has the action `alwaysRerun` meaning it will be run in every execution that requires it, so the `gcc --version` is always checked. This rule defines no dependencies (no `need` actions), so if it lacked `alwaysRerun`, this rule would only be run when `gcc.version` was missing. The function then runs `gcc --version` storing the output in `stdout`. Finally, it calls `writeFileChanged` which writes `stdout` to `out`, but only if the contents have changed. The use of `writeFileChanged` is important otherwise `gcc.version` would change in every run. To use this rule, we `need ["gcc.version"]` in every rule that calls `gcc`.++Shake also contains a feature called "oracles", which lets you do the same thing without the use of a file, which is sometimes more convenient. Interested readers should look at the function documentation list for `addOracle`.++#### Resources++Resources allow us to limit the number of simultaneous operations more precisely than just the number of simultaneous jobs (the `-j` flag). For example, calls to compilers are usually CPU bound but calls to linkers are usually disk bound. Running 8 linkers will often cause an 8 CPU system to grid to a halt. We can limit ourselves to 4 linkers with:++    disk <- newResource "Disk" 4+    want [show i <.> "exe" | i <- [1..100]]+    "*.exe" %> \out -> do+        withResource disk 1 $ do+            cmd_ "ld -o" [out] ...+    "*.o" %> \out -> do+        cmd_ "cl -o" [out] ...++Assuming `-j8`, this allows up to 8 compilers, but only a maximum of 4 linkers.++#### Multiple outputs++Some tools, for example [bison](https://www.gnu.org/software/bison/), can generate multiple outputs from one execution. We can track these in Shake using the `&%>` operator to define rules:++    ["//*.bison.h","//*.bison.c"] &%> \[outh, outc] -> do+        let src = outc -<.> "y"+        cmd_ "bison -d -o" [outc] [src]++Now we define a list of patterns that are matched, and get a list of output files. If any output file is required, then all output files will be built, with proper dependencies.++#### Changing build rules++Shake build systems are set up to rebuild files when the dependencies change, but mostly assume that the build rules themselves do not change (including both the code and the shell commands contained within). To minimise the impact of build rule changes there are three approaches:++_Use configuration files:_ Most build information, such as which files a C file includes, can be computed from source files. Where such information is not available, such as which C files should be linked together to form an executable, use configuration files to provide the information. The rule for linking can use these configuration files, which can be properly tracked. Moving any regularly changing configuration into separate files will significantly reduce the number of build system changes.++_Depend on the build source:_ One approach is to depend on the build system source in each of the rules, then if _any_ rules change, _everything_ will rebuild. While this option is safe, it may cause a significant number of redundant rebuilds. As a restricted version of this technique, for a generated file you can include a dependency on the generator source and use `writeFileChanged`. If the generator changes it will rerun, but typically only a few generated files will change, so little is rebuilt.++_Use a version stamp:_ There is a field named `shakeVersion` in the `ShakeOptions` record. If the build system changes in a significant and incompatible way, you can change this field to force a full rebuild. If you want all rules to depend on all rules, you can put a hash of the build system source in the version field, as [described here](https://stackoverflow.com/questions/18532552/shake-how-to-reliably-automatically-force-rebuild-when-my-rules-change-becomi/18532553#18532553).++## The Haskell Zone++From now on, this manual assumes some moderate knowledge of Haskell. Most of the things in this section are either impossible to do with other build systems or can be faked by shell script. None of the Haskell is particularly advanced.++#### Haskell Expressions++You can use any Haskell function at any point. For example, to only link files without numbers in them, we can `import Data.Char` and then write:++    let os = ["_build" </> c -<.> "o" | c <- inputs, not $ any isDigit c]++For defining non-overlapping rules it is sometimes useful to use a more advanced predicate. For example, to define a rule that only builds results which have a numeric extension, we can use the `?>` rule definition function:++    (\x -> all isDigit $ drop 1 $ takeExtension x) ?> \out -> do+        ...++We first get the extension with `takeExtension`, then use `drop 1` to remove the leading `.` that `takeExtension` includes, then test that all the characters are numeric.++The standard `%>` operator is actually defined as:++    pattern %> actions = (pattern ?==) ?> actions++Where `?==` is a function for matching file patterns.++#### Haskell Actions++You can run any Haskell `IO` action by using `liftIO`. As an example:++    liftIO $ launchMissiles True++Most common IO operations to run as actions are already wrapped and available in the Shake library, including `readFile'`, `writeFile'` and `copyFile'`. Other useful functions can be found in `System.Directory`.
+ docs/manual/Shakefile.hs view
@@ -0,0 +1,24 @@+import Development.Shake+import Development.Shake.Command+import Development.Shake.FilePath+import Development.Shake.Util++main :: IO ()+main = shakeArgs shakeOptions{shakeFiles="_build"} $ do+    want ["_build/run" <.> exe]++    phony "clean" $ do+        putInfo "Cleaning files in _build"+        removeFilesAfter "_build" ["//*"]++    "_build/run" <.> exe %> \out -> do+        cs <- getDirectoryFiles "" ["//*.c"]+        let os = ["_build" </> c -<.> "o" | c <- cs]+        need os+        cmd_ "gcc -o" [out] os++    "_build//*.o" %> \out -> do+        let c = dropDirectory1 $ out -<.> "c"+        let m = out -<.> "m"+        cmd_ "gcc -c" [c] "-o" [out] "-MMD -MF" [m]+        neededMakefileDependencies m
+ docs/manual/build.bat view
@@ -0,0 +1,2 @@+@mkdir _shake 2> nul
+@ghc --make Shakefile.hs -rtsopts -threaded -with-rtsopts=-I0 -outputdir=_shake -o _shake/build && _shake\build %*
+ docs/manual/build.sh view
@@ -0,0 +1,3 @@+#!/bin/sh+mkdir -p _shake+ghc --make Shakefile.hs -rtsopts -threaded -with-rtsopts=-I0 -outputdir=_shake -o _shake/build && _shake/build "$@"
+ docs/manual/constants.c view
@@ -0,0 +1,7 @@++char msg[] = "Hello Shake Users!";++char* message()+{+    return msg;+}
+ docs/manual/constants.h view
@@ -0,0 +1,1 @@+char* message();
+ docs/manual/main.c view
@@ -0,0 +1,8 @@+#include <stdio.h>+#include "constants.h"++int main()+{+    printf("%s\n", message());+    return 0;+}
+ docs/shake-progress.png view

binary file changed (absent → 9744 bytes)

− html/bootstrap-responsive.min.css
@@ -1,4 +0,0 @@-.clearfix{*zoom:1;}.clearfix:before,.clearfix:after{display:table;content:"";}-.clearfix:after{clear:both;}-.hidden{display:none;visibility:hidden;}-@media (max-width:480px){.nav-collapse{-webkit-transform:translate3d(0, 0, 0);} .page-header h1 small{display:block;line-height:18px;} input[class*="span"],select[class*="span"],textarea[class*="span"],.uneditable-input{display:block;width:100%;min-height:28px;-webkit-box-sizing:border-box;-moz-box-sizing:border-box;-ms-box-sizing:border-box;box-sizing:border-box;} .input-prepend input[class*="span"],.input-append input[class*="span"]{width:auto;} input[type="checkbox"],input[type="radio"]{border:1px solid #ccc;} .form-horizontal .control-group>label{float:none;width:auto;padding-top:0;text-align:left;} .form-horizontal .controls{margin-left:0;} .form-horizontal .control-list{padding-top:0;} .form-horizontal .form-actions{padding-left:10px;padding-right:10px;} .modal{position:absolute;top:10px;left:10px;right:10px;width:auto;margin:0;}.modal.fade.in{top:auto;} .modal-header .close{padding:10px;margin:-10px;} .carousel-caption{position:static;}}@media (max-width:767px){.container{width:auto;padding:0 20px;} .row-fluid{width:100%;} .row{margin-left:0;} .row>[class*="span"],.row-fluid>[class*="span"]{float:none;display:block;width:auto;margin:0;}}@media (min-width:768px) and (max-width:979px){.row{margin-left:-20px;*zoom:1;}.row:before,.row:after{display:table;content:"";} .row:after{clear:both;} [class*="span"]{float:left;margin-left:20px;} .span1{width:42px;} .span2{width:104px;} .span3{width:166px;} .span4{width:228px;} .span5{width:290px;} .span6{width:352px;} .span7{width:414px;} .span8{width:476px;} .span9{width:538px;} .span10{width:600px;} .span11{width:662px;} .span12,.container{width:724px;} .offset1{margin-left:82px;} .offset2{margin-left:144px;} .offset3{margin-left:206px;} .offset4{margin-left:268px;} .offset5{margin-left:330px;} .offset6{margin-left:392px;} .offset7{margin-left:454px;} .offset8{margin-left:516px;} .offset9{margin-left:578px;} .offset10{margin-left:640px;} .offset11{margin-left:702px;} .row-fluid{width:100%;*zoom:1;}.row-fluid:before,.row-fluid:after{display:table;content:"";} .row-fluid:after{clear:both;} .row-fluid>[class*="span"]{float:left;margin-left:2.762430939%;} .row-fluid>[class*="span"]:first-child{margin-left:0;} .row-fluid>.span1{width:5.801104972%;} .row-fluid>.span2{width:14.364640883%;} .row-fluid>.span3{width:22.928176794%;} .row-fluid>.span4{width:31.491712705%;} .row-fluid>.span5{width:40.055248616%;} .row-fluid>.span6{width:48.618784527%;} .row-fluid>.span7{width:57.182320438000005%;} .row-fluid>.span8{width:65.74585634900001%;} .row-fluid>.span9{width:74.30939226%;} .row-fluid>.span10{width:82.87292817100001%;} .row-fluid>.span11{width:91.436464082%;} .row-fluid>.span12{width:99.999999993%;} input.span1,textarea.span1,.uneditable-input.span1{width:32px;} input.span2,textarea.span2,.uneditable-input.span2{width:94px;} input.span3,textarea.span3,.uneditable-input.span3{width:156px;} input.span4,textarea.span4,.uneditable-input.span4{width:218px;} input.span5,textarea.span5,.uneditable-input.span5{width:280px;} input.span6,textarea.span6,.uneditable-input.span6{width:342px;} input.span7,textarea.span7,.uneditable-input.span7{width:404px;} input.span8,textarea.span8,.uneditable-input.span8{width:466px;} input.span9,textarea.span9,.uneditable-input.span9{width:528px;} input.span10,textarea.span10,.uneditable-input.span10{width:590px;} input.span11,textarea.span11,.uneditable-input.span11{width:652px;} input.span12,textarea.span12,.uneditable-input.span12{width:714px;}}@media (max-width:979px){body{padding-top:0;} .navbar-fixed-top{position:static;margin-bottom:18px;} .navbar-fixed-top .navbar-inner{padding:5px;} .navbar .container{width:auto;padding:0;} .navbar .brand{padding-left:10px;padding-right:10px;margin:0 0 0 -5px;} .navbar .nav-collapse{clear:left;} .navbar .nav{float:none;margin:0 0 9px;} .navbar .nav>li{float:none;} .navbar .nav>li>a{margin-bottom:2px;} .navbar .nav>.divider-vertical{display:none;} .navbar .nav .nav-header{color:#999999;text-shadow:none;} .navbar .nav>li>a,.navbar .dropdown-menu a{padding:6px 15px;font-weight:bold;color:#999999;-webkit-border-radius:3px;-moz-border-radius:3px;border-radius:3px;} .navbar .dropdown-menu li+li a{margin-bottom:2px;} .navbar .nav>li>a:hover,.navbar .dropdown-menu a:hover{background-color:#222222;} .navbar .dropdown-menu{position:static;top:auto;left:auto;float:none;display:block;max-width:none;margin:0 15px;padding:0;background-color:transparent;border:none;-webkit-border-radius:0;-moz-border-radius:0;border-radius:0;-webkit-box-shadow:none;-moz-box-shadow:none;box-shadow:none;} .navbar .dropdown-menu:before,.navbar .dropdown-menu:after{display:none;} .navbar .dropdown-menu .divider{display:none;} .navbar-form,.navbar-search{float:none;padding:9px 15px;margin:9px 0;border-top:1px solid #222222;border-bottom:1px solid #222222;-webkit-box-shadow:inset 0 1px 0 rgba(255, 255, 255, 0.1),0 1px 0 rgba(255, 255, 255, 0.1);-moz-box-shadow:inset 0 1px 0 rgba(255, 255, 255, 0.1),0 1px 0 rgba(255, 255, 255, 0.1);box-shadow:inset 0 1px 0 rgba(255, 255, 255, 0.1),0 1px 0 rgba(255, 255, 255, 0.1);} .navbar .nav.pull-right{float:none;margin-left:0;} .navbar-static .navbar-inner{padding-left:10px;padding-right:10px;} .btn-navbar{display:block;} .nav-collapse{overflow:hidden;height:0;}}@media (min-width:980px){.nav-collapse.collapse{height:auto !important;}}@media (min-width:1200px){.row{margin-left:-30px;*zoom:1;}.row:before,.row:after{display:table;content:"";} .row:after{clear:both;} [class*="span"]{float:left;margin-left:30px;} .span1{width:70px;} .span2{width:170px;} .span3{width:270px;} .span4{width:370px;} .span5{width:470px;} .span6{width:570px;} .span7{width:670px;} .span8{width:770px;} .span9{width:870px;} .span10{width:970px;} .span11{width:1070px;} .span12,.container{width:1170px;} .offset1{margin-left:130px;} .offset2{margin-left:230px;} .offset3{margin-left:330px;} .offset4{margin-left:430px;} .offset5{margin-left:530px;} .offset6{margin-left:630px;} .offset7{margin-left:730px;} .offset8{margin-left:830px;} .offset9{margin-left:930px;} .offset10{margin-left:1030px;} .offset11{margin-left:1130px;} .row-fluid{width:100%;*zoom:1;}.row-fluid:before,.row-fluid:after{display:table;content:"";} .row-fluid:after{clear:both;} .row-fluid>[class*="span"]{float:left;margin-left:2.564102564%;} .row-fluid>[class*="span"]:first-child{margin-left:0;} .row-fluid>.span1{width:5.982905983%;} .row-fluid>.span2{width:14.529914530000001%;} .row-fluid>.span3{width:23.076923077%;} .row-fluid>.span4{width:31.623931624%;} .row-fluid>.span5{width:40.170940171000005%;} .row-fluid>.span6{width:48.717948718%;} .row-fluid>.span7{width:57.264957265%;} .row-fluid>.span8{width:65.81196581200001%;} .row-fluid>.span9{width:74.358974359%;} .row-fluid>.span10{width:82.905982906%;} .row-fluid>.span11{width:91.45299145300001%;} .row-fluid>.span12{width:100%;} input.span1,textarea.span1,.uneditable-input.span1{width:60px;} input.span2,textarea.span2,.uneditable-input.span2{width:160px;} input.span3,textarea.span3,.uneditable-input.span3{width:260px;} input.span4,textarea.span4,.uneditable-input.span4{width:360px;} input.span5,textarea.span5,.uneditable-input.span5{width:460px;} input.span6,textarea.span6,.uneditable-input.span6{width:560px;} input.span7,textarea.span7,.uneditable-input.span7{width:660px;} input.span8,textarea.span8,.uneditable-input.span8{width:760px;} input.span9,textarea.span9,.uneditable-input.span9{width:860px;} input.span10,textarea.span10,.uneditable-input.span10{width:960px;} input.span11,textarea.span11,.uneditable-input.span11{width:1060px;} input.span12,textarea.span12,.uneditable-input.span12{width:1160px;} .thumbnails{margin-left:-30px;} .thumbnails>li{margin-left:30px;}}
− html/bootstrap.min.css
@@ -1,632 +0,0 @@-article,aside,details,figcaption,figure,footer,header,hgroup,nav,section{display:block;}-audio,canvas,video{display:inline-block;*display:inline;*zoom:1;}-audio:not([controls]){display:none;}-html{font-size:100%;-webkit-text-size-adjust:100%;-ms-text-size-adjust:100%;}-a:focus{outline:thin dotted #333;outline:5px auto -webkit-focus-ring-color;outline-offset:-2px;}-a:hover,a:active{outline:0;}-sub,sup{position:relative;font-size:75%;line-height:0;vertical-align:baseline;}-sup{top:-0.5em;}-sub{bottom:-0.25em;}-img{max-width:100%;height:auto;border:0;-ms-interpolation-mode:bicubic;}-button,input,select,textarea{margin:0;font-size:100%;vertical-align:middle;}-button,input{*overflow:visible;line-height:normal;}-button::-moz-focus-inner,input::-moz-focus-inner{padding:0;border:0;}-button,input[type="button"],input[type="reset"],input[type="submit"]{cursor:pointer;-webkit-appearance:button;}-input[type="search"]{-webkit-appearance:textfield;-webkit-box-sizing:content-box;-moz-box-sizing:content-box;box-sizing:content-box;}-input[type="search"]::-webkit-search-decoration,input[type="search"]::-webkit-search-cancel-button{-webkit-appearance:none;}-textarea{overflow:auto;vertical-align:top;}-.clearfix{*zoom:1;}.clearfix:before,.clearfix:after{display:table;content:"";}-.clearfix:after{clear:both;}-body{margin:0;font-family:"Helvetica Neue",Helvetica,Arial,sans-serif;font-size:13px;line-height:18px;color:#333333;background-color:#ffffff;}-a{color:#0088cc;text-decoration:none;}-a:hover{color:#005580;text-decoration:underline;}-.row{margin-left:-20px;*zoom:1;}.row:before,.row:after{display:table;content:"";}-.row:after{clear:both;}-[class*="span"]{float:left;margin-left:20px;}-.span1{width:60px;}-.span2{width:140px;}-.span3{width:220px;}-.span4{width:300px;}-.span5{width:380px;}-.span6{width:460px;}-.span7{width:540px;}-.span8{width:620px;}-.span9{width:700px;}-.span10{width:780px;}-.span11{width:860px;}-.span12,.container{width:940px;}-.offset1{margin-left:100px;}-.offset2{margin-left:180px;}-.offset3{margin-left:260px;}-.offset4{margin-left:340px;}-.offset5{margin-left:420px;}-.offset6{margin-left:500px;}-.offset7{margin-left:580px;}-.offset8{margin-left:660px;}-.offset9{margin-left:740px;}-.offset10{margin-left:820px;}-.offset11{margin-left:900px;}-.row-fluid{width:100%;*zoom:1;}.row-fluid:before,.row-fluid:after{display:table;content:"";}-.row-fluid:after{clear:both;}-.row-fluid>[class*="span"]{float:left;margin-left:2.127659574%;}-.row-fluid>[class*="span"]:first-child{margin-left:0;}-.row-fluid>.span1{width:6.382978723%;}-.row-fluid>.span2{width:14.89361702%;}-.row-fluid>.span3{width:23.404255317%;}-.row-fluid>.span4{width:31.914893614%;}-.row-fluid>.span5{width:40.425531911%;}-.row-fluid>.span6{width:48.93617020799999%;}-.row-fluid>.span7{width:57.446808505%;}-.row-fluid>.span8{width:65.95744680199999%;}-.row-fluid>.span9{width:74.468085099%;}-.row-fluid>.span10{width:82.97872339599999%;}-.row-fluid>.span11{width:91.489361693%;}-.row-fluid>.span12{width:99.99999998999999%;}-.container{width:940px;margin-left:auto;margin-right:auto;*zoom:1;}.container:before,.container:after{display:table;content:"";}-.container:after{clear:both;}-.container-fluid{padding-left:20px;padding-right:20px;*zoom:1;}.container-fluid:before,.container-fluid:after{display:table;content:"";}-.container-fluid:after{clear:both;}-p{margin:0 0 9px;font-family:"Helvetica Neue",Helvetica,Arial,sans-serif;font-size:13px;line-height:18px;}p small{font-size:11px;color:#999999;}-.lead{margin-bottom:18px;font-size:20px;font-weight:200;line-height:27px;}-h1,h2,h3,h4,h5,h6{margin:0;font-weight:bold;color:#333333;text-rendering:optimizelegibility;}h1 small,h2 small,h3 small,h4 small,h5 small,h6 small{font-weight:normal;color:#999999;}-h1{font-size:30px;line-height:36px;}h1 small{font-size:18px;}-h2{font-size:24px;line-height:36px;}h2 small{font-size:18px;}-h3{line-height:27px;font-size:18px;}h3 small{font-size:14px;}-h4,h5,h6{line-height:18px;}-h4{font-size:14px;}h4 small{font-size:12px;}-h5{font-size:12px;}-h6{font-size:11px;color:#999999;text-transform:uppercase;}-.page-header{padding-bottom:17px;margin:18px 0;border-bottom:1px solid #eeeeee;}-.page-header h1{line-height:1;}-ul,ol{padding:0;margin:0 0 9px 25px;}-ul ul,ul ol,ol ol,ol ul{margin-bottom:0;}-ul{list-style:disc;}-ol{list-style:decimal;}-li{line-height:18px;}-ul.unstyled,ol.unstyled{margin-left:0;list-style:none;}-dl{margin-bottom:18px;}-dt,dd{line-height:18px;}-dt{font-weight:bold;}-dd{margin-left:9px;}-hr{margin:18px 0;border:0;border-top:1px solid #eeeeee;border-bottom:1px solid #ffffff;}-strong{font-weight:bold;}-em{font-style:italic;}-.muted{color:#999999;}-abbr{font-size:90%;text-transform:uppercase;border-bottom:1px dotted #ddd;cursor:help;}-blockquote{padding:0 0 0 15px;margin:0 0 18px;border-left:5px solid #eeeeee;}blockquote p{margin-bottom:0;font-size:16px;font-weight:300;line-height:22.5px;}-blockquote small{display:block;line-height:18px;color:#999999;}blockquote small:before{content:'\2014 \00A0';}-blockquote.pull-right{float:right;padding-left:0;padding-right:15px;border-left:0;border-right:5px solid #eeeeee;}blockquote.pull-right p,blockquote.pull-right small{text-align:right;}-q:before,q:after,blockquote:before,blockquote:after{content:"";}-address{display:block;margin-bottom:18px;line-height:18px;font-style:normal;}-small{font-size:100%;}-cite{font-style:normal;}-code,pre{padding:0 3px 2px;font-family:Menlo,Monaco,"Courier New",monospace;font-size:12px;color:#333333;-webkit-border-radius:3px;-moz-border-radius:3px;border-radius:3px;}-code{padding:3px 4px;color:#d14;background-color:#f7f7f9;border:1px solid #e1e1e8;}-pre{display:block;padding:8.5px;margin:0 0 9px;font-size:12px;line-height:18px;background-color:#f5f5f5;border:1px solid #ccc;border:1px solid rgba(0, 0, 0, 0.15);-webkit-border-radius:4px;-moz-border-radius:4px;border-radius:4px;white-space:pre;white-space:pre-wrap;word-break:break-all;word-wrap:break-word;}pre.prettyprint{margin-bottom:18px;}-pre code{padding:0;color:inherit;background-color:transparent;border:0;}-.pre-scrollable{max-height:340px;overflow-y:scroll;}-form{margin:0 0 18px;}-fieldset{padding:0;margin:0;border:0;}-legend{display:block;width:100%;padding:0;margin-bottom:27px;font-size:19.5px;line-height:36px;color:#333333;border:0;border-bottom:1px solid #eee;}legend small{font-size:13.5px;color:#999999;}-label,input,button,select,textarea{font-size:13px;font-weight:normal;line-height:18px;}-input,button,select,textarea{font-family:"Helvetica Neue",Helvetica,Arial,sans-serif;}-label{display:block;margin-bottom:5px;color:#333333;}-input,textarea,select,.uneditable-input{display:inline-block;width:210px;height:18px;padding:4px;margin-bottom:9px;font-size:13px;line-height:18px;color:#555555;border:1px solid #ccc;-webkit-border-radius:3px;-moz-border-radius:3px;border-radius:3px;}-.uneditable-textarea{width:auto;height:auto;}-label input,label textarea,label select{display:block;}-input[type="image"],input[type="checkbox"],input[type="radio"]{width:auto;height:auto;padding:0;margin:3px 0;*margin-top:0;line-height:normal;cursor:pointer;-webkit-border-radius:0;-moz-border-radius:0;border-radius:0;border:0 \9;}-input[type="image"]{border:0;}-input[type="file"]{width:auto;padding:initial;line-height:initial;border:initial;background-color:#ffffff;background-color:initial;-webkit-box-shadow:none;-moz-box-shadow:none;box-shadow:none;}-input[type="button"],input[type="reset"],input[type="submit"]{width:auto;height:auto;}-select,input[type="file"]{height:28px;*margin-top:4px;line-height:28px;}-input[type="file"]{line-height:18px \9;}-select{width:220px;background-color:#ffffff;}-select[multiple],select[size]{height:auto;}-input[type="image"]{-webkit-box-shadow:none;-moz-box-shadow:none;box-shadow:none;}-textarea{height:auto;}-input[type="hidden"]{display:none;}-.radio,.checkbox{padding-left:18px;}-.radio input[type="radio"],.checkbox input[type="checkbox"]{float:left;margin-left:-18px;}-.controls>.radio:first-child,.controls>.checkbox:first-child{padding-top:5px;}-.radio.inline,.checkbox.inline{display:inline-block;padding-top:5px;margin-bottom:0;vertical-align:middle;}-.radio.inline+.radio.inline,.checkbox.inline+.checkbox.inline{margin-left:10px;}-input,textarea{-webkit-box-shadow:inset 0 1px 1px rgba(0, 0, 0, 0.075);-moz-box-shadow:inset 0 1px 1px rgba(0, 0, 0, 0.075);box-shadow:inset 0 1px 1px rgba(0, 0, 0, 0.075);-webkit-transition:border linear 0.2s,box-shadow linear 0.2s;-moz-transition:border linear 0.2s,box-shadow linear 0.2s;-ms-transition:border linear 0.2s,box-shadow linear 0.2s;-o-transition:border linear 0.2s,box-shadow linear 0.2s;transition:border linear 0.2s,box-shadow linear 0.2s;}-input:focus,textarea:focus{border-color:rgba(82, 168, 236, 0.8);-webkit-box-shadow:inset 0 1px 1px rgba(0, 0, 0, 0.075),0 0 8px rgba(82, 168, 236, 0.6);-moz-box-shadow:inset 0 1px 1px rgba(0, 0, 0, 0.075),0 0 8px rgba(82, 168, 236, 0.6);box-shadow:inset 0 1px 1px rgba(0, 0, 0, 0.075),0 0 8px rgba(82, 168, 236, 0.6);outline:0;outline:thin dotted \9;}-input[type="file"]:focus,input[type="radio"]:focus,input[type="checkbox"]:focus,select:focus{-webkit-box-shadow:none;-moz-box-shadow:none;box-shadow:none;outline:thin dotted #333;outline:5px auto -webkit-focus-ring-color;outline-offset:-2px;}-.input-mini{width:60px;}-.input-small{width:90px;}-.input-medium{width:150px;}-.input-large{width:210px;}-.input-xlarge{width:270px;}-.input-xxlarge{width:530px;}-input[class*="span"],select[class*="span"],textarea[class*="span"],.uneditable-input{float:none;margin-left:0;}-input.span1,textarea.span1,.uneditable-input.span1{width:50px;}-input.span2,textarea.span2,.uneditable-input.span2{width:130px;}-input.span3,textarea.span3,.uneditable-input.span3{width:210px;}-input.span4,textarea.span4,.uneditable-input.span4{width:290px;}-input.span5,textarea.span5,.uneditable-input.span5{width:370px;}-input.span6,textarea.span6,.uneditable-input.span6{width:450px;}-input.span7,textarea.span7,.uneditable-input.span7{width:530px;}-input.span8,textarea.span8,.uneditable-input.span8{width:610px;}-input.span9,textarea.span9,.uneditable-input.span9{width:690px;}-input.span10,textarea.span10,.uneditable-input.span10{width:770px;}-input.span11,textarea.span11,.uneditable-input.span11{width:850px;}-input.span12,textarea.span12,.uneditable-input.span12{width:930px;}-input[disabled],select[disabled],textarea[disabled],input[readonly],select[readonly],textarea[readonly]{background-color:#f5f5f5;border-color:#ddd;cursor:not-allowed;}-.control-group.warning>label,.control-group.warning .help-block,.control-group.warning .help-inline{color:#c09853;}-.control-group.warning input,.control-group.warning select,.control-group.warning textarea{color:#c09853;border-color:#c09853;}.control-group.warning input:focus,.control-group.warning select:focus,.control-group.warning textarea:focus{border-color:#a47e3c;-webkit-box-shadow:0 0 6px #dbc59e;-moz-box-shadow:0 0 6px #dbc59e;box-shadow:0 0 6px #dbc59e;}-.control-group.warning .input-prepend .add-on,.control-group.warning .input-append .add-on{color:#c09853;background-color:#fcf8e3;border-color:#c09853;}-.control-group.error>label,.control-group.error .help-block,.control-group.error .help-inline{color:#b94a48;}-.control-group.error input,.control-group.error select,.control-group.error textarea{color:#b94a48;border-color:#b94a48;}.control-group.error input:focus,.control-group.error select:focus,.control-group.error textarea:focus{border-color:#953b39;-webkit-box-shadow:0 0 6px #d59392;-moz-box-shadow:0 0 6px #d59392;box-shadow:0 0 6px #d59392;}-.control-group.error .input-prepend .add-on,.control-group.error .input-append .add-on{color:#b94a48;background-color:#f2dede;border-color:#b94a48;}-.control-group.success>label,.control-group.success .help-block,.control-group.success .help-inline{color:#468847;}-.control-group.success input,.control-group.success select,.control-group.success textarea{color:#468847;border-color:#468847;}.control-group.success input:focus,.control-group.success select:focus,.control-group.success textarea:focus{border-color:#356635;-webkit-box-shadow:0 0 6px #7aba7b;-moz-box-shadow:0 0 6px #7aba7b;box-shadow:0 0 6px #7aba7b;}-.control-group.success .input-prepend .add-on,.control-group.success .input-append .add-on{color:#468847;background-color:#dff0d8;border-color:#468847;}-input:focus:required:invalid,textarea:focus:required:invalid,select:focus:required:invalid{color:#b94a48;border-color:#ee5f5b;}input:focus:required:invalid:focus,textarea:focus:required:invalid:focus,select:focus:required:invalid:focus{border-color:#e9322d;-webkit-box-shadow:0 0 6px #f8b9b7;-moz-box-shadow:0 0 6px #f8b9b7;box-shadow:0 0 6px #f8b9b7;}-.form-actions{padding:17px 20px 18px;margin-top:18px;margin-bottom:18px;background-color:#f5f5f5;border-top:1px solid #ddd;}-.uneditable-input{display:block;background-color:#ffffff;border-color:#eee;-webkit-box-shadow:inset 0 1px 2px rgba(0, 0, 0, 0.025);-moz-box-shadow:inset 0 1px 2px rgba(0, 0, 0, 0.025);box-shadow:inset 0 1px 2px rgba(0, 0, 0, 0.025);cursor:not-allowed;}-:-moz-placeholder{color:#999999;}-::-webkit-input-placeholder{color:#999999;}-.help-block{display:block;margin-top:5px;margin-bottom:0;color:#999999;}-.help-inline{display:inline-block;*display:inline;*zoom:1;margin-bottom:9px;vertical-align:middle;padding-left:5px;}-.input-prepend,.input-append{margin-bottom:5px;*zoom:1;}.input-prepend:before,.input-append:before,.input-prepend:after,.input-append:after{display:table;content:"";}-.input-prepend:after,.input-append:after{clear:both;}-.input-prepend input,.input-append input,.input-prepend .uneditable-input,.input-append .uneditable-input{-webkit-border-radius:0 3px 3px 0;-moz-border-radius:0 3px 3px 0;border-radius:0 3px 3px 0;}.input-prepend input:focus,.input-append input:focus,.input-prepend .uneditable-input:focus,.input-append .uneditable-input:focus{position:relative;z-index:2;}-.input-prepend .uneditable-input,.input-append .uneditable-input{border-left-color:#ccc;}-.input-prepend .add-on,.input-append .add-on{float:left;display:block;width:auto;min-width:16px;height:18px;margin-right:-1px;padding:4px 5px;font-weight:normal;line-height:18px;color:#999999;text-align:center;text-shadow:0 1px 0 #ffffff;background-color:#f5f5f5;border:1px solid #ccc;-webkit-border-radius:3px 0 0 3px;-moz-border-radius:3px 0 0 3px;border-radius:3px 0 0 3px;}-.input-prepend .active,.input-append .active{background-color:#a9dba9;border-color:#46a546;}-.input-prepend .add-on{*margin-top:1px;}-.input-append input,.input-append .uneditable-input{float:left;-webkit-border-radius:3px 0 0 3px;-moz-border-radius:3px 0 0 3px;border-radius:3px 0 0 3px;}-.input-append .uneditable-input{border-left-color:#eee;border-right-color:#ccc;}-.input-append .add-on{margin-right:0;margin-left:-1px;-webkit-border-radius:0 3px 3px 0;-moz-border-radius:0 3px 3px 0;border-radius:0 3px 3px 0;}-.input-append input:first-child{*margin-left:-160px;}.input-append input:first-child+.add-on{*margin-left:-21px;}-.search-query{padding-left:14px;padding-right:14px;margin-bottom:0;-webkit-border-radius:14px;-moz-border-radius:14px;border-radius:14px;}-.form-search input,.form-inline input,.form-horizontal input,.form-search textarea,.form-inline textarea,.form-horizontal textarea,.form-search select,.form-inline select,.form-horizontal select,.form-search .help-inline,.form-inline .help-inline,.form-horizontal .help-inline,.form-search .uneditable-input,.form-inline .uneditable-input,.form-horizontal .uneditable-input{display:inline-block;margin-bottom:0;}-.form-search .hide,.form-inline .hide,.form-horizontal .hide{display:none;}-.form-search label,.form-inline label,.form-search .input-append,.form-inline .input-append,.form-search .input-prepend,.form-inline .input-prepend{display:inline-block;}-.form-search .input-append .add-on,.form-inline .input-prepend .add-on,.form-search .input-append .add-on,.form-inline .input-prepend .add-on{vertical-align:middle;}-.form-search .radio,.form-inline .radio,.form-search .checkbox,.form-inline .checkbox{margin-bottom:0;vertical-align:middle;}-.control-group{margin-bottom:9px;}-legend+.control-group{margin-top:18px;-webkit-margin-top-collapse:separate;}-.form-horizontal .control-group{margin-bottom:18px;*zoom:1;}.form-horizontal .control-group:before,.form-horizontal .control-group:after{display:table;content:"";}-.form-horizontal .control-group:after{clear:both;}-.form-horizontal .control-label{float:left;width:140px;padding-top:5px;text-align:right;}-.form-horizontal .controls{margin-left:160px;}-.form-horizontal .form-actions{padding-left:160px;}-table{max-width:100%;border-collapse:collapse;border-spacing:0;}-.table{width:100%;margin-bottom:18px;}.table th,.table td{padding:8px;line-height:18px;text-align:left;vertical-align:top;border-top:1px solid #ddd;}-.table th{font-weight:bold;}-.table thead th{vertical-align:bottom;}-.table thead:first-child tr th,.table thead:first-child tr td{border-top:0;}-.table tbody+tbody{border-top:2px solid #ddd;}-.table-condensed th,.table-condensed td{padding:4px 5px;}-.table-bordered{border:1px solid #ddd;border-collapse:separate;*border-collapse:collapsed;-webkit-border-radius:4px;-moz-border-radius:4px;border-radius:4px;}.table-bordered th+th,.table-bordered td+td,.table-bordered th+td,.table-bordered td+th{border-left:1px solid #ddd;}-.table-bordered thead:first-child tr:first-child th,.table-bordered tbody:first-child tr:first-child th,.table-bordered tbody:first-child tr:first-child td{border-top:0;}-.table-bordered thead:first-child tr:first-child th:first-child,.table-bordered tbody:first-child tr:first-child td:first-child{-webkit-border-radius:4px 0 0 0;-moz-border-radius:4px 0 0 0;border-radius:4px 0 0 0;}-.table-bordered thead:first-child tr:first-child th:last-child,.table-bordered tbody:first-child tr:first-child td:last-child{-webkit-border-radius:0 4px 0 0;-moz-border-radius:0 4px 0 0;border-radius:0 4px 0 0;}-.table-bordered thead:last-child tr:last-child th:first-child,.table-bordered tbody:last-child tr:last-child td:first-child{-webkit-border-radius:0 0 0 4px;-moz-border-radius:0 0 0 4px;border-radius:0 0 0 4px;}-.table-bordered thead:last-child tr:last-child th:last-child,.table-bordered tbody:last-child tr:last-child td:last-child{-webkit-border-radius:0 0 4px 0;-moz-border-radius:0 0 4px 0;border-radius:0 0 4px 0;}-.table-striped tbody tr:nth-child(odd) td,.table-striped tbody tr:nth-child(odd) th{background-color:#f9f9f9;}-.table tbody tr:hover td,.table tbody tr:hover th{background-color:#f5f5f5;}-table .span1{float:none;width:44px;margin-left:0;}-table .span2{float:none;width:124px;margin-left:0;}-table .span3{float:none;width:204px;margin-left:0;}-table .span4{float:none;width:284px;margin-left:0;}-table .span5{float:none;width:364px;margin-left:0;}-table .span6{float:none;width:444px;margin-left:0;}-table .span7{float:none;width:524px;margin-left:0;}-table .span8{float:none;width:604px;margin-left:0;}-table .span9{float:none;width:684px;margin-left:0;}-table .span10{float:none;width:764px;margin-left:0;}-table .span11{float:none;width:844px;margin-left:0;}-table .span12{float:none;width:924px;margin-left:0;}-[class^="icon-"],[class*=" icon-"]{display:inline-block;width:14px;height:14px;line-height:14px;vertical-align:text-top;background-image:url("../img/glyphicons-halflings.png");background-position:14px 14px;background-repeat:no-repeat;*margin-right:.3em;}[class^="icon-"]:last-child,[class*=" icon-"]:last-child{*margin-left:0;}-.icon-white{background-image:url("../img/glyphicons-halflings-white.png");}-.icon-glass{background-position:0 0;}-.icon-music{background-position:-24px 0;}-.icon-search{background-position:-48px 0;}-.icon-envelope{background-position:-72px 0;}-.icon-heart{background-position:-96px 0;}-.icon-star{background-position:-120px 0;}-.icon-star-empty{background-position:-144px 0;}-.icon-user{background-position:-168px 0;}-.icon-film{background-position:-192px 0;}-.icon-th-large{background-position:-216px 0;}-.icon-th{background-position:-240px 0;}-.icon-th-list{background-position:-264px 0;}-.icon-ok{background-position:-288px 0;}-.icon-remove{background-position:-312px 0;}-.icon-zoom-in{background-position:-336px 0;}-.icon-zoom-out{background-position:-360px 0;}-.icon-off{background-position:-384px 0;}-.icon-signal{background-position:-408px 0;}-.icon-cog{background-position:-432px 0;}-.icon-trash{background-position:-456px 0;}-.icon-home{background-position:0 -24px;}-.icon-file{background-position:-24px -24px;}-.icon-time{background-position:-48px -24px;}-.icon-road{background-position:-72px -24px;}-.icon-download-alt{background-position:-96px -24px;}-.icon-download{background-position:-120px -24px;}-.icon-upload{background-position:-144px -24px;}-.icon-inbox{background-position:-168px -24px;}-.icon-play-circle{background-position:-192px -24px;}-.icon-repeat{background-position:-216px -24px;}-.icon-refresh{background-position:-240px -24px;}-.icon-list-alt{background-position:-264px -24px;}-.icon-lock{background-position:-287px -24px;}-.icon-flag{background-position:-312px -24px;}-.icon-headphones{background-position:-336px -24px;}-.icon-volume-off{background-position:-360px -24px;}-.icon-volume-down{background-position:-384px -24px;}-.icon-volume-up{background-position:-408px -24px;}-.icon-qrcode{background-position:-432px -24px;}-.icon-barcode{background-position:-456px -24px;}-.icon-tag{background-position:0 -48px;}-.icon-tags{background-position:-25px -48px;}-.icon-book{background-position:-48px -48px;}-.icon-bookmark{background-position:-72px -48px;}-.icon-print{background-position:-96px -48px;}-.icon-camera{background-position:-120px -48px;}-.icon-font{background-position:-144px -48px;}-.icon-bold{background-position:-167px -48px;}-.icon-italic{background-position:-192px -48px;}-.icon-text-height{background-position:-216px -48px;}-.icon-text-width{background-position:-240px -48px;}-.icon-align-left{background-position:-264px -48px;}-.icon-align-center{background-position:-288px -48px;}-.icon-align-right{background-position:-312px -48px;}-.icon-align-justify{background-position:-336px -48px;}-.icon-list{background-position:-360px -48px;}-.icon-indent-left{background-position:-384px -48px;}-.icon-indent-right{background-position:-408px -48px;}-.icon-facetime-video{background-position:-432px -48px;}-.icon-picture{background-position:-456px -48px;}-.icon-pencil{background-position:0 -72px;}-.icon-map-marker{background-position:-24px -72px;}-.icon-adjust{background-position:-48px -72px;}-.icon-tint{background-position:-72px -72px;}-.icon-edit{background-position:-96px -72px;}-.icon-share{background-position:-120px -72px;}-.icon-check{background-position:-144px -72px;}-.icon-move{background-position:-168px -72px;}-.icon-step-backward{background-position:-192px -72px;}-.icon-fast-backward{background-position:-216px -72px;}-.icon-backward{background-position:-240px -72px;}-.icon-play{background-position:-264px -72px;}-.icon-pause{background-position:-288px -72px;}-.icon-stop{background-position:-312px -72px;}-.icon-forward{background-position:-336px -72px;}-.icon-fast-forward{background-position:-360px -72px;}-.icon-step-forward{background-position:-384px -72px;}-.icon-eject{background-position:-408px -72px;}-.icon-chevron-left{background-position:-432px -72px;}-.icon-chevron-right{background-position:-456px -72px;}-.icon-plus-sign{background-position:0 -96px;}-.icon-minus-sign{background-position:-24px -96px;}-.icon-remove-sign{background-position:-48px -96px;}-.icon-ok-sign{background-position:-72px -96px;}-.icon-question-sign{background-position:-96px -96px;}-.icon-info-sign{background-position:-120px -96px;}-.icon-screenshot{background-position:-144px -96px;}-.icon-remove-circle{background-position:-168px -96px;}-.icon-ok-circle{background-position:-192px -96px;}-.icon-ban-circle{background-position:-216px -96px;}-.icon-arrow-left{background-position:-240px -96px;}-.icon-arrow-right{background-position:-264px -96px;}-.icon-arrow-up{background-position:-289px -96px;}-.icon-arrow-down{background-position:-312px -96px;}-.icon-share-alt{background-position:-336px -96px;}-.icon-resize-full{background-position:-360px -96px;}-.icon-resize-small{background-position:-384px -96px;}-.icon-plus{background-position:-408px -96px;}-.icon-minus{background-position:-433px -96px;}-.icon-asterisk{background-position:-456px -96px;}-.icon-exclamation-sign{background-position:0 -120px;}-.icon-gift{background-position:-24px -120px;}-.icon-leaf{background-position:-48px -120px;}-.icon-fire{background-position:-72px -120px;}-.icon-eye-open{background-position:-96px -120px;}-.icon-eye-close{background-position:-120px -120px;}-.icon-warning-sign{background-position:-144px -120px;}-.icon-plane{background-position:-168px -120px;}-.icon-calendar{background-position:-192px -120px;}-.icon-random{background-position:-216px -120px;}-.icon-comment{background-position:-240px -120px;}-.icon-magnet{background-position:-264px -120px;}-.icon-chevron-up{background-position:-288px -120px;}-.icon-chevron-down{background-position:-313px -119px;}-.icon-retweet{background-position:-336px -120px;}-.icon-shopping-cart{background-position:-360px -120px;}-.icon-folder-close{background-position:-384px -120px;}-.icon-folder-open{background-position:-408px -120px;}-.icon-resize-vertical{background-position:-432px -119px;}-.icon-resize-horizontal{background-position:-456px -118px;}-.dropdown{position:relative;}-.dropdown-toggle{*margin-bottom:-3px;}-.dropdown-toggle:active,.open .dropdown-toggle{outline:0;}-.caret{display:inline-block;width:0;height:0;text-indent:-99999px;*text-indent:0;vertical-align:top;border-left:4px solid transparent;border-right:4px solid transparent;border-top:4px solid #000000;opacity:0.3;filter:alpha(opacity=30);content:"\2193";}-.dropdown .caret{margin-top:8px;margin-left:2px;}-.dropdown:hover .caret,.open.dropdown .caret{opacity:1;filter:alpha(opacity=100);}-.dropdown-menu{position:absolute;top:100%;left:0;z-index:1000;float:left;display:none;min-width:160px;_width:160px;padding:4px 0;margin:0;list-style:none;background-color:#ffffff;border-color:#ccc;border-color:rgba(0, 0, 0, 0.2);border-style:solid;border-width:1px;-webkit-border-radius:0 0 5px 5px;-moz-border-radius:0 0 5px 5px;border-radius:0 0 5px 5px;-webkit-box-shadow:0 5px 10px rgba(0, 0, 0, 0.2);-moz-box-shadow:0 5px 10px rgba(0, 0, 0, 0.2);box-shadow:0 5px 10px rgba(0, 0, 0, 0.2);-webkit-background-clip:padding-box;-moz-background-clip:padding;background-clip:padding-box;*border-right-width:2px;*border-bottom-width:2px;}.dropdown-menu.bottom-up{top:auto;bottom:100%;margin-bottom:2px;}-.dropdown-menu .divider{height:1px;margin:5px 1px;overflow:hidden;background-color:#e5e5e5;border-bottom:1px solid #ffffff;*width:100%;*margin:-5px 0 5px;}-.dropdown-menu a{display:block;padding:3px 15px;clear:both;font-weight:normal;line-height:18px;color:#555555;white-space:nowrap;}-.dropdown-menu li>a:hover,.dropdown-menu .active>a,.dropdown-menu .active>a:hover{color:#ffffff;text-decoration:none;background-color:#0088cc;}-.dropdown.open{*z-index:1000;}.dropdown.open .dropdown-toggle{color:#ffffff;background:#ccc;background:rgba(0, 0, 0, 0.3);}-.dropdown.open .dropdown-menu{display:block;}-.typeahead{margin-top:2px;-webkit-border-radius:4px;-moz-border-radius:4px;border-radius:4px;}-.well{min-height:20px;padding:19px;margin-bottom:20px;background-color:#f5f5f5;border:1px solid #eee;border:1px solid rgba(0, 0, 0, 0.05);-webkit-border-radius:4px;-moz-border-radius:4px;border-radius:4px;-webkit-box-shadow:inset 0 1px 1px rgba(0, 0, 0, 0.05);-moz-box-shadow:inset 0 1px 1px rgba(0, 0, 0, 0.05);box-shadow:inset 0 1px 1px rgba(0, 0, 0, 0.05);}.well blockquote{border-color:#ddd;border-color:rgba(0, 0, 0, 0.15);}-.fade{-webkit-transition:opacity 0.15s linear;-moz-transition:opacity 0.15s linear;-ms-transition:opacity 0.15s linear;-o-transition:opacity 0.15s linear;transition:opacity 0.15s linear;opacity:0;}.fade.in{opacity:1;}-.collapse{-webkit-transition:height 0.35s ease;-moz-transition:height 0.35s ease;-ms-transition:height 0.35s ease;-o-transition:height 0.35s ease;transition:height 0.35s ease;position:relative;overflow:hidden;height:0;}.collapse.in{height:auto;}-.close{float:right;font-size:20px;font-weight:bold;line-height:18px;color:#000000;text-shadow:0 1px 0 #ffffff;opacity:0.2;filter:alpha(opacity=20);}.close:hover{color:#000000;text-decoration:none;opacity:0.4;filter:alpha(opacity=40);cursor:pointer;}-.btn{display:inline-block;padding:4px 10px 4px;margin-bottom:0;font-size:13px;line-height:18px;color:#333333;text-align:center;text-shadow:0 1px 1px rgba(255, 255, 255, 0.75);vertical-align:middle;background-color:#f5f5f5;background-image:-moz-linear-gradient(top, #ffffff, #e6e6e6);background-image:-ms-linear-gradient(top, #ffffff, #e6e6e6);background-image:-webkit-gradient(linear, 0 0, 0 100%, from(#ffffff), to(#e6e6e6));background-image:-webkit-linear-gradient(top, #ffffff, #e6e6e6);background-image:-o-linear-gradient(top, #ffffff, #e6e6e6);background-image:linear-gradient(top, #ffffff, #e6e6e6);background-repeat:repeat-x;filter:progid:DXImageTransform.Microsoft.gradient(startColorstr='#ffffff', endColorstr='#e6e6e6', GradientType=0);border-color:#e6e6e6 #e6e6e6 #bfbfbf;border-color:rgba(0, 0, 0, 0.1) rgba(0, 0, 0, 0.1) rgba(0, 0, 0, 0.25);filter:progid:DXImageTransform.Microsoft.gradient(enabled = false);border:1px solid #ccc;border-bottom-color:#bbb;-webkit-border-radius:4px;-moz-border-radius:4px;border-radius:4px;-webkit-box-shadow:inset 0 1px 0 rgba(255, 255, 255, 0.2),0 1px 2px rgba(0, 0, 0, 0.05);-moz-box-shadow:inset 0 1px 0 rgba(255, 255, 255, 0.2),0 1px 2px rgba(0, 0, 0, 0.05);box-shadow:inset 0 1px 0 rgba(255, 255, 255, 0.2),0 1px 2px rgba(0, 0, 0, 0.05);cursor:pointer;filter:progid:DXImageTransform.Microsoft.gradient(enabled = false);*margin-left:.3em;}.btn:hover,.btn:active,.btn.active,.btn.disabled,.btn[disabled]{background-color:#e6e6e6;}-.btn:active,.btn.active{background-color:#cccccc \9;}-.btn:first-child{*margin-left:0;}-.btn:hover{color:#333333;text-decoration:none;background-color:#e6e6e6;background-position:0 -15px;-webkit-transition:background-position 0.1s linear;-moz-transition:background-position 0.1s linear;-ms-transition:background-position 0.1s linear;-o-transition:background-position 0.1s linear;transition:background-position 0.1s linear;}-.btn:focus{outline:thin dotted #333;outline:5px auto -webkit-focus-ring-color;outline-offset:-2px;}-.btn.active,.btn:active{background-image:none;-webkit-box-shadow:inset 0 2px 4px rgba(0, 0, 0, 0.15),0 1px 2px rgba(0, 0, 0, 0.05);-moz-box-shadow:inset 0 2px 4px rgba(0, 0, 0, 0.15),0 1px 2px rgba(0, 0, 0, 0.05);box-shadow:inset 0 2px 4px rgba(0, 0, 0, 0.15),0 1px 2px rgba(0, 0, 0, 0.05);background-color:#e6e6e6;background-color:#d9d9d9 \9;outline:0;}-.btn.disabled,.btn[disabled]{cursor:default;background-image:none;background-color:#e6e6e6;opacity:0.65;filter:alpha(opacity=65);-webkit-box-shadow:none;-moz-box-shadow:none;box-shadow:none;}-.btn-large{padding:9px 14px;font-size:15px;line-height:normal;-webkit-border-radius:5px;-moz-border-radius:5px;border-radius:5px;}-.btn-large [class^="icon-"]{margin-top:1px;}-.btn-small{padding:5px 9px;font-size:11px;line-height:16px;}-.btn-small [class^="icon-"]{margin-top:-1px;}-.btn-mini{padding:2px 6px;font-size:11px;line-height:14px;}-.btn-primary,.btn-primary:hover,.btn-warning,.btn-warning:hover,.btn-danger,.btn-danger:hover,.btn-success,.btn-success:hover,.btn-info,.btn-info:hover,.btn-inverse,.btn-inverse:hover{text-shadow:0 -1px 0 rgba(0, 0, 0, 0.25);color:#ffffff;}-.btn-primary.active,.btn-warning.active,.btn-danger.active,.btn-success.active,.btn-info.active,.btn-dark.active{color:rgba(255, 255, 255, 0.75);}-.btn-primary{background-color:#006dcc;background-image:-moz-linear-gradient(top, #0088cc, #0044cc);background-image:-ms-linear-gradient(top, #0088cc, #0044cc);background-image:-webkit-gradient(linear, 0 0, 0 100%, from(#0088cc), to(#0044cc));background-image:-webkit-linear-gradient(top, #0088cc, #0044cc);background-image:-o-linear-gradient(top, #0088cc, #0044cc);background-image:linear-gradient(top, #0088cc, #0044cc);background-repeat:repeat-x;filter:progid:DXImageTransform.Microsoft.gradient(startColorstr='#0088cc', endColorstr='#0044cc', GradientType=0);border-color:#0044cc #0044cc #002a80;border-color:rgba(0, 0, 0, 0.1) rgba(0, 0, 0, 0.1) rgba(0, 0, 0, 0.25);filter:progid:DXImageTransform.Microsoft.gradient(enabled = false);}.btn-primary:hover,.btn-primary:active,.btn-primary.active,.btn-primary.disabled,.btn-primary[disabled]{background-color:#0044cc;}-.btn-primary:active,.btn-primary.active{background-color:#003399 \9;}-.btn-warning{background-color:#faa732;background-image:-moz-linear-gradient(top, #fbb450, #f89406);background-image:-ms-linear-gradient(top, #fbb450, #f89406);background-image:-webkit-gradient(linear, 0 0, 0 100%, from(#fbb450), to(#f89406));background-image:-webkit-linear-gradient(top, #fbb450, #f89406);background-image:-o-linear-gradient(top, #fbb450, #f89406);background-image:linear-gradient(top, #fbb450, #f89406);background-repeat:repeat-x;filter:progid:DXImageTransform.Microsoft.gradient(startColorstr='#fbb450', endColorstr='#f89406', GradientType=0);border-color:#f89406 #f89406 #ad6704;border-color:rgba(0, 0, 0, 0.1) rgba(0, 0, 0, 0.1) rgba(0, 0, 0, 0.25);filter:progid:DXImageTransform.Microsoft.gradient(enabled = false);}.btn-warning:hover,.btn-warning:active,.btn-warning.active,.btn-warning.disabled,.btn-warning[disabled]{background-color:#f89406;}-.btn-warning:active,.btn-warning.active{background-color:#c67605 \9;}-.btn-danger{background-color:#da4f49;background-image:-moz-linear-gradient(top, #ee5f5b, #bd362f);background-image:-ms-linear-gradient(top, #ee5f5b, #bd362f);background-image:-webkit-gradient(linear, 0 0, 0 100%, from(#ee5f5b), to(#bd362f));background-image:-webkit-linear-gradient(top, #ee5f5b, #bd362f);background-image:-o-linear-gradient(top, #ee5f5b, #bd362f);background-image:linear-gradient(top, #ee5f5b, #bd362f);background-repeat:repeat-x;filter:progid:DXImageTransform.Microsoft.gradient(startColorstr='#ee5f5b', endColorstr='#bd362f', GradientType=0);border-color:#bd362f #bd362f #802420;border-color:rgba(0, 0, 0, 0.1) rgba(0, 0, 0, 0.1) rgba(0, 0, 0, 0.25);filter:progid:DXImageTransform.Microsoft.gradient(enabled = false);}.btn-danger:hover,.btn-danger:active,.btn-danger.active,.btn-danger.disabled,.btn-danger[disabled]{background-color:#bd362f;}-.btn-danger:active,.btn-danger.active{background-color:#942a25 \9;}-.btn-success{background-color:#5bb75b;background-image:-moz-linear-gradient(top, #62c462, #51a351);background-image:-ms-linear-gradient(top, #62c462, #51a351);background-image:-webkit-gradient(linear, 0 0, 0 100%, from(#62c462), to(#51a351));background-image:-webkit-linear-gradient(top, #62c462, #51a351);background-image:-o-linear-gradient(top, #62c462, #51a351);background-image:linear-gradient(top, #62c462, #51a351);background-repeat:repeat-x;filter:progid:DXImageTransform.Microsoft.gradient(startColorstr='#62c462', endColorstr='#51a351', GradientType=0);border-color:#51a351 #51a351 #387038;border-color:rgba(0, 0, 0, 0.1) rgba(0, 0, 0, 0.1) rgba(0, 0, 0, 0.25);filter:progid:DXImageTransform.Microsoft.gradient(enabled = false);}.btn-success:hover,.btn-success:active,.btn-success.active,.btn-success.disabled,.btn-success[disabled]{background-color:#51a351;}-.btn-success:active,.btn-success.active{background-color:#408140 \9;}-.btn-info{background-color:#49afcd;background-image:-moz-linear-gradient(top, #5bc0de, #2f96b4);background-image:-ms-linear-gradient(top, #5bc0de, #2f96b4);background-image:-webkit-gradient(linear, 0 0, 0 100%, from(#5bc0de), to(#2f96b4));background-image:-webkit-linear-gradient(top, #5bc0de, #2f96b4);background-image:-o-linear-gradient(top, #5bc0de, #2f96b4);background-image:linear-gradient(top, #5bc0de, #2f96b4);background-repeat:repeat-x;filter:progid:DXImageTransform.Microsoft.gradient(startColorstr='#5bc0de', endColorstr='#2f96b4', GradientType=0);border-color:#2f96b4 #2f96b4 #1f6377;border-color:rgba(0, 0, 0, 0.1) rgba(0, 0, 0, 0.1) rgba(0, 0, 0, 0.25);filter:progid:DXImageTransform.Microsoft.gradient(enabled = false);}.btn-info:hover,.btn-info:active,.btn-info.active,.btn-info.disabled,.btn-info[disabled]{background-color:#2f96b4;}-.btn-info:active,.btn-info.active{background-color:#24748c \9;}-.btn-inverse{background-color:#393939;background-image:-moz-linear-gradient(top, #454545, #262626);background-image:-ms-linear-gradient(top, #454545, #262626);background-image:-webkit-gradient(linear, 0 0, 0 100%, from(#454545), to(#262626));background-image:-webkit-linear-gradient(top, #454545, #262626);background-image:-o-linear-gradient(top, #454545, #262626);background-image:linear-gradient(top, #454545, #262626);background-repeat:repeat-x;filter:progid:DXImageTransform.Microsoft.gradient(startColorstr='#454545', endColorstr='#262626', GradientType=0);border-color:#262626 #262626 #000000;border-color:rgba(0, 0, 0, 0.1) rgba(0, 0, 0, 0.1) rgba(0, 0, 0, 0.25);filter:progid:DXImageTransform.Microsoft.gradient(enabled = false);}.btn-inverse:hover,.btn-inverse:active,.btn-inverse.active,.btn-inverse.disabled,.btn-inverse[disabled]{background-color:#262626;}-.btn-inverse:active,.btn-inverse.active{background-color:#0c0c0c \9;}-button.btn,input[type="submit"].btn{*padding-top:2px;*padding-bottom:2px;}button.btn::-moz-focus-inner,input[type="submit"].btn::-moz-focus-inner{padding:0;border:0;}-button.btn.large,input[type="submit"].btn.large{*padding-top:7px;*padding-bottom:7px;}-button.btn.small,input[type="submit"].btn.small{*padding-top:3px;*padding-bottom:3px;}-.btn-group{position:relative;*zoom:1;*margin-left:.3em;}.btn-group:before,.btn-group:after{display:table;content:"";}-.btn-group:after{clear:both;}-.btn-group:first-child{*margin-left:0;}-.btn-group+.btn-group{margin-left:5px;}-.btn-toolbar{margin-top:9px;margin-bottom:9px;}.btn-toolbar .btn-group{display:inline-block;*display:inline;*zoom:1;}-.btn-group .btn{position:relative;float:left;margin-left:-1px;-webkit-border-radius:0;-moz-border-radius:0;border-radius:0;}-.btn-group .btn:first-child{margin-left:0;-webkit-border-top-left-radius:4px;-moz-border-radius-topleft:4px;border-top-left-radius:4px;-webkit-border-bottom-left-radius:4px;-moz-border-radius-bottomleft:4px;border-bottom-left-radius:4px;}-.btn-group .btn:last-child,.btn-group .dropdown-toggle{-webkit-border-top-right-radius:4px;-moz-border-radius-topright:4px;border-top-right-radius:4px;-webkit-border-bottom-right-radius:4px;-moz-border-radius-bottomright:4px;border-bottom-right-radius:4px;}-.btn-group .btn.large:first-child{margin-left:0;-webkit-border-top-left-radius:6px;-moz-border-radius-topleft:6px;border-top-left-radius:6px;-webkit-border-bottom-left-radius:6px;-moz-border-radius-bottomleft:6px;border-bottom-left-radius:6px;}-.btn-group .btn.large:last-child,.btn-group .large.dropdown-toggle{-webkit-border-top-right-radius:6px;-moz-border-radius-topright:6px;border-top-right-radius:6px;-webkit-border-bottom-right-radius:6px;-moz-border-radius-bottomright:6px;border-bottom-right-radius:6px;}-.btn-group .btn:hover,.btn-group .btn:focus,.btn-group .btn:active,.btn-group .btn.active{z-index:2;}-.btn-group .dropdown-toggle:active,.btn-group.open .dropdown-toggle{outline:0;}-.btn-group .dropdown-toggle{padding-left:8px;padding-right:8px;-webkit-box-shadow:inset 1px 0 0 rgba(255, 255, 255, 0.125),inset 0 1px 0 rgba(255, 255, 255, 0.2),0 1px 2px rgba(0, 0, 0, 0.05);-moz-box-shadow:inset 1px 0 0 rgba(255, 255, 255, 0.125),inset 0 1px 0 rgba(255, 255, 255, 0.2),0 1px 2px rgba(0, 0, 0, 0.05);box-shadow:inset 1px 0 0 rgba(255, 255, 255, 0.125),inset 0 1px 0 rgba(255, 255, 255, 0.2),0 1px 2px rgba(0, 0, 0, 0.05);*padding-top:5px;*padding-bottom:5px;}-.btn-group.open{*z-index:1000;}.btn-group.open .dropdown-menu{display:block;margin-top:1px;-webkit-border-radius:5px;-moz-border-radius:5px;border-radius:5px;}-.btn-group.open .dropdown-toggle{background-image:none;-webkit-box-shadow:inset 0 1px 6px rgba(0, 0, 0, 0.15),0 1px 2px rgba(0, 0, 0, 0.05);-moz-box-shadow:inset 0 1px 6px rgba(0, 0, 0, 0.15),0 1px 2px rgba(0, 0, 0, 0.05);box-shadow:inset 0 1px 6px rgba(0, 0, 0, 0.15),0 1px 2px rgba(0, 0, 0, 0.05);}-.btn .caret{margin-top:7px;margin-left:0;}-.btn:hover .caret,.open.btn-group .caret{opacity:1;filter:alpha(opacity=100);}-.btn-primary .caret,.btn-danger .caret,.btn-info .caret,.btn-success .caret,.btn-inverse .caret{border-top-color:#ffffff;opacity:0.75;filter:alpha(opacity=75);}-.btn-small .caret{margin-top:4px;}-.alert{padding:8px 35px 8px 14px;margin-bottom:18px;text-shadow:0 1px 0 rgba(255, 255, 255, 0.5);background-color:#fcf8e3;border:1px solid #fbeed5;-webkit-border-radius:4px;-moz-border-radius:4px;border-radius:4px;}-.alert,.alert-heading{color:#c09853;}-.alert .close{position:relative;top:-2px;right:-21px;line-height:18px;}-.alert-success{background-color:#dff0d8;border-color:#d6e9c6;}-.alert-success,.alert-success .alert-heading{color:#468847;}-.alert-danger,.alert-error{background-color:#f2dede;border-color:#eed3d7;}-.alert-danger,.alert-error,.alert-danger .alert-heading,.alert-error .alert-heading{color:#b94a48;}-.alert-info{background-color:#d9edf7;border-color:#bce8f1;}-.alert-info,.alert-info .alert-heading{color:#3a87ad;}-.alert-block{padding-top:14px;padding-bottom:14px;}-.alert-block>p,.alert-block>ul{margin-bottom:0;}-.alert-block p+p{margin-top:5px;}-.nav{margin-left:0;margin-bottom:18px;list-style:none;}-.nav>li>a{display:block;}-.nav>li>a:hover{text-decoration:none;background-color:#eeeeee;}-.nav .nav-header{display:block;padding:3px 15px;font-size:11px;font-weight:bold;line-height:18px;color:#999999;text-shadow:0 1px 0 rgba(255, 255, 255, 0.5);text-transform:uppercase;}-.nav li+.nav-header{margin-top:9px;}-.nav-list{padding-left:14px;padding-right:14px;margin-bottom:0;}-.nav-list>li>a,.nav-list .nav-header{margin-left:-15px;margin-right:-15px;text-shadow:0 1px 0 rgba(255, 255, 255, 0.5);}-.nav-list>li>a{padding:3px 15px;}-.nav-list .active>a,.nav-list .active>a:hover{color:#ffffff;text-shadow:0 -1px 0 rgba(0, 0, 0, 0.2);background-color:#0088cc;}-.nav-list [class^="icon-"]{margin-right:2px;}-.nav-tabs,.nav-pills{*zoom:1;}.nav-tabs:before,.nav-pills:before,.nav-tabs:after,.nav-pills:after{display:table;content:"";}-.nav-tabs:after,.nav-pills:after{clear:both;}-.nav-tabs>li,.nav-pills>li{float:left;}-.nav-tabs>li>a,.nav-pills>li>a{padding-right:12px;padding-left:12px;margin-right:2px;line-height:14px;}-.nav-tabs{border-bottom:1px solid #ddd;}-.nav-tabs>li{margin-bottom:-1px;}-.nav-tabs>li>a{padding-top:9px;padding-bottom:9px;border:1px solid transparent;-webkit-border-radius:4px 4px 0 0;-moz-border-radius:4px 4px 0 0;border-radius:4px 4px 0 0;}.nav-tabs>li>a:hover{border-color:#eeeeee #eeeeee #dddddd;}-.nav-tabs>.active>a,.nav-tabs>.active>a:hover{color:#555555;background-color:#ffffff;border:1px solid #ddd;border-bottom-color:transparent;cursor:default;}-.nav-pills>li>a{padding-top:8px;padding-bottom:8px;margin-top:2px;margin-bottom:2px;-webkit-border-radius:5px;-moz-border-radius:5px;border-radius:5px;}-.nav-pills .active>a,.nav-pills .active>a:hover{color:#ffffff;background-color:#0088cc;}-.nav-stacked>li{float:none;}-.nav-stacked>li>a{margin-right:0;}-.nav-tabs.nav-stacked{border-bottom:0;}-.nav-tabs.nav-stacked>li>a{border:1px solid #ddd;-webkit-border-radius:0;-moz-border-radius:0;border-radius:0;}-.nav-tabs.nav-stacked>li:first-child>a{-webkit-border-radius:4px 4px 0 0;-moz-border-radius:4px 4px 0 0;border-radius:4px 4px 0 0;}-.nav-tabs.nav-stacked>li:last-child>a{-webkit-border-radius:0 0 4px 4px;-moz-border-radius:0 0 4px 4px;border-radius:0 0 4px 4px;}-.nav-tabs.nav-stacked>li>a:hover{border-color:#ddd;z-index:2;}-.nav-pills.nav-stacked>li>a{margin-bottom:3px;}-.nav-pills.nav-stacked>li:last-child>a{margin-bottom:1px;}-.nav-tabs .dropdown-menu,.nav-pills .dropdown-menu{margin-top:1px;border-width:1px;}-.nav-pills .dropdown-menu{-webkit-border-radius:4px;-moz-border-radius:4px;border-radius:4px;}-.nav-tabs .dropdown-toggle .caret,.nav-pills .dropdown-toggle .caret{border-top-color:#0088cc;margin-top:6px;}-.nav-tabs .dropdown-toggle:hover .caret,.nav-pills .dropdown-toggle:hover .caret{border-top-color:#005580;}-.nav-tabs .active .dropdown-toggle .caret,.nav-pills .active .dropdown-toggle .caret{border-top-color:#333333;}-.nav>.dropdown.active>a:hover{color:#000000;cursor:pointer;}-.nav-tabs .open .dropdown-toggle,.nav-pills .open .dropdown-toggle,.nav>.open.active>a:hover{color:#ffffff;background-color:#999999;border-color:#999999;}-.nav .open .caret,.nav .open.active .caret,.nav .open a:hover .caret{border-top-color:#ffffff;opacity:1;filter:alpha(opacity=100);}-.tabs-stacked .open>a:hover{border-color:#999999;}-.tabbable{*zoom:1;}.tabbable:before,.tabbable:after{display:table;content:"";}-.tabbable:after{clear:both;}-.tab-content{overflow:hidden;}-.tabs-below .nav-tabs,.tabs-right .nav-tabs,.tabs-left .nav-tabs{border-bottom:0;}-.tab-content>.tab-pane,.pill-content>.pill-pane{display:none;}-.tab-content>.active,.pill-content>.active{display:block;}-.tabs-below .nav-tabs{border-top:1px solid #ddd;}-.tabs-below .nav-tabs>li{margin-top:-1px;margin-bottom:0;}-.tabs-below .nav-tabs>li>a{-webkit-border-radius:0 0 4px 4px;-moz-border-radius:0 0 4px 4px;border-radius:0 0 4px 4px;}.tabs-below .nav-tabs>li>a:hover{border-bottom-color:transparent;border-top-color:#ddd;}-.tabs-below .nav-tabs .active>a,.tabs-below .nav-tabs .active>a:hover{border-color:transparent #ddd #ddd #ddd;}-.tabs-left .nav-tabs>li,.tabs-right .nav-tabs>li{float:none;}-.tabs-left .nav-tabs>li>a,.tabs-right .nav-tabs>li>a{min-width:74px;margin-right:0;margin-bottom:3px;}-.tabs-left .nav-tabs{float:left;margin-right:19px;border-right:1px solid #ddd;}-.tabs-left .nav-tabs>li>a{margin-right:-1px;-webkit-border-radius:4px 0 0 4px;-moz-border-radius:4px 0 0 4px;border-radius:4px 0 0 4px;}-.tabs-left .nav-tabs>li>a:hover{border-color:#eeeeee #dddddd #eeeeee #eeeeee;}-.tabs-left .nav-tabs .active>a,.tabs-left .nav-tabs .active>a:hover{border-color:#ddd transparent #ddd #ddd;*border-right-color:#ffffff;}-.tabs-right .nav-tabs{float:right;margin-left:19px;border-left:1px solid #ddd;}-.tabs-right .nav-tabs>li>a{margin-left:-1px;-webkit-border-radius:0 4px 4px 0;-moz-border-radius:0 4px 4px 0;border-radius:0 4px 4px 0;}-.tabs-right .nav-tabs>li>a:hover{border-color:#eeeeee #eeeeee #eeeeee #dddddd;}-.tabs-right .nav-tabs .active>a,.tabs-right .nav-tabs .active>a:hover{border-color:#ddd #ddd #ddd transparent;*border-left-color:#ffffff;}-.navbar{overflow:visible;margin-bottom:18px;}-.navbar-inner{padding-left:20px;padding-right:20px;background-color:#2c2c2c;background-image:-moz-linear-gradient(top, #333333, #222222);background-image:-ms-linear-gradient(top, #333333, #222222);background-image:-webkit-gradient(linear, 0 0, 0 100%, from(#333333), to(#222222));background-image:-webkit-linear-gradient(top, #333333, #222222);background-image:-o-linear-gradient(top, #333333, #222222);background-image:linear-gradient(top, #333333, #222222);background-repeat:repeat-x;filter:progid:DXImageTransform.Microsoft.gradient(startColorstr='#333333', endColorstr='#222222', GradientType=0);-webkit-border-radius:4px;-moz-border-radius:4px;border-radius:4px;-webkit-box-shadow:0 1px 3px rgba(0, 0, 0, 0.25),inset 0 -1px 0 rgba(0, 0, 0, 0.1);-moz-box-shadow:0 1px 3px rgba(0, 0, 0, 0.25),inset 0 -1px 0 rgba(0, 0, 0, 0.1);box-shadow:0 1px 3px rgba(0, 0, 0, 0.25),inset 0 -1px 0 rgba(0, 0, 0, 0.1);}-.btn-navbar{display:none;float:right;padding:7px 10px;margin-left:5px;margin-right:5px;background-color:#2c2c2c;background-image:-moz-linear-gradient(top, #333333, #222222);background-image:-ms-linear-gradient(top, #333333, #222222);background-image:-webkit-gradient(linear, 0 0, 0 100%, from(#333333), to(#222222));background-image:-webkit-linear-gradient(top, #333333, #222222);background-image:-o-linear-gradient(top, #333333, #222222);background-image:linear-gradient(top, #333333, #222222);background-repeat:repeat-x;filter:progid:DXImageTransform.Microsoft.gradient(startColorstr='#333333', endColorstr='#222222', GradientType=0);border-color:#222222 #222222 #000000;border-color:rgba(0, 0, 0, 0.1) rgba(0, 0, 0, 0.1) rgba(0, 0, 0, 0.25);filter:progid:DXImageTransform.Microsoft.gradient(enabled = false);-webkit-box-shadow:inset 0 1px 0 rgba(255, 255, 255, 0.1),0 1px 0 rgba(255, 255, 255, 0.075);-moz-box-shadow:inset 0 1px 0 rgba(255, 255, 255, 0.1),0 1px 0 rgba(255, 255, 255, 0.075);box-shadow:inset 0 1px 0 rgba(255, 255, 255, 0.1),0 1px 0 rgba(255, 255, 255, 0.075);}.btn-navbar:hover,.btn-navbar:active,.btn-navbar.active,.btn-navbar.disabled,.btn-navbar[disabled]{background-color:#222222;}-.btn-navbar:active,.btn-navbar.active{background-color:#080808 \9;}-.btn-navbar .icon-bar{display:block;width:18px;height:2px;background-color:#f5f5f5;-webkit-border-radius:1px;-moz-border-radius:1px;border-radius:1px;-webkit-box-shadow:0 1px 0 rgba(0, 0, 0, 0.25);-moz-box-shadow:0 1px 0 rgba(0, 0, 0, 0.25);box-shadow:0 1px 0 rgba(0, 0, 0, 0.25);}-.btn-navbar .icon-bar+.icon-bar{margin-top:3px;}-.nav-collapse.collapse{height:auto;}-.navbar .brand:hover{text-decoration:none;}-.navbar .brand{float:left;display:block;padding:8px 20px 12px;margin-left:-20px;font-size:20px;font-weight:200;line-height:1;color:#ffffff;}-.navbar .navbar-text{margin-bottom:0;line-height:40px;color:#999999;}.navbar .navbar-text a:hover{color:#ffffff;background-color:transparent;}-.navbar .btn,.navbar .btn-group{margin-top:5px;}-.navbar .btn-group .btn{margin-top:0;}-.navbar-form{margin-bottom:0;*zoom:1;}.navbar-form:before,.navbar-form:after{display:table;content:"";}-.navbar-form:after{clear:both;}-.navbar-form input,.navbar-form select{display:inline-block;margin-top:5px;margin-bottom:0;}-.navbar-form .radio,.navbar-form .checkbox{margin-top:5px;}-.navbar-form input[type="image"],.navbar-form input[type="checkbox"],.navbar-form input[type="radio"]{margin-top:3px;}-.navbar-form .input-append,.navbar-form .input-prepend{margin-top:6px;white-space:nowrap;}.navbar-form .input-append input,.navbar-form .input-prepend input{margin-top:0;}-.navbar-search{position:relative;float:left;margin-top:6px;margin-bottom:0;}.navbar-search .search-query{padding:4px 9px;font-family:"Helvetica Neue",Helvetica,Arial,sans-serif;font-size:13px;font-weight:normal;line-height:1;color:#ffffff;color:rgba(255, 255, 255, 0.75);background:#666;background:rgba(255, 255, 255, 0.3);border:1px solid #111;-webkit-box-shadow:inset 0 1px 2px rgba(0, 0, 0, 0.1),0 1px 0px rgba(255, 255, 255, 0.15);-moz-box-shadow:inset 0 1px 2px rgba(0, 0, 0, 0.1),0 1px 0px rgba(255, 255, 255, 0.15);box-shadow:inset 0 1px 2px rgba(0, 0, 0, 0.1),0 1px 0px rgba(255, 255, 255, 0.15);-webkit-transition:none;-moz-transition:none;-ms-transition:none;-o-transition:none;transition:none;}.navbar-search .search-query :-moz-placeholder{color:#eeeeee;}-.navbar-search .search-query::-webkit-input-placeholder{color:#eeeeee;}-.navbar-search .search-query:hover{color:#ffffff;background-color:#999999;background-color:rgba(255, 255, 255, 0.5);}-.navbar-search .search-query:focus,.navbar-search .search-query.focused{padding:5px 10px;color:#333333;text-shadow:0 1px 0 #ffffff;background-color:#ffffff;border:0;-webkit-box-shadow:0 0 3px rgba(0, 0, 0, 0.15);-moz-box-shadow:0 0 3px rgba(0, 0, 0, 0.15);box-shadow:0 0 3px rgba(0, 0, 0, 0.15);outline:0;}-.navbar-fixed-top{position:fixed;top:0;right:0;left:0;z-index:1030;}-.navbar-fixed-top .navbar-inner{padding-left:0;padding-right:0;-webkit-border-radius:0;-moz-border-radius:0;border-radius:0;}-.navbar .nav{position:relative;left:0;display:block;float:left;margin:0 10px 0 0;}-.navbar .nav.pull-right{float:right;}-.navbar .nav>li{display:block;float:left;}-.navbar .nav>li>a{float:none;padding:10px 10px 11px;line-height:19px;color:#999999;text-decoration:none;text-shadow:0 -1px 0 rgba(0, 0, 0, 0.25);}-.navbar .nav>li>a:hover{background-color:transparent;color:#ffffff;text-decoration:none;}-.navbar .nav .active>a,.navbar .nav .active>a:hover{color:#ffffff;text-decoration:none;background-color:#222222;}-.navbar .divider-vertical{height:40px;width:1px;margin:0 9px;overflow:hidden;background-color:#222222;border-right:1px solid #333333;}-.navbar .nav.pull-right{margin-left:10px;margin-right:0;}-.navbar .dropdown-menu{margin-top:1px;-webkit-border-radius:4px;-moz-border-radius:4px;border-radius:4px;}.navbar .dropdown-menu:before{content:'';display:inline-block;border-left:7px solid transparent;border-right:7px solid transparent;border-bottom:7px solid #ccc;border-bottom-color:rgba(0, 0, 0, 0.2);position:absolute;top:-7px;left:9px;}-.navbar .dropdown-menu:after{content:'';display:inline-block;border-left:6px solid transparent;border-right:6px solid transparent;border-bottom:6px solid #ffffff;position:absolute;top:-6px;left:10px;}-.navbar .nav .dropdown-toggle .caret,.navbar .nav .open.dropdown .caret{border-top-color:#ffffff;}-.navbar .nav .active .caret{opacity:1;filter:alpha(opacity=100);}-.navbar .nav .open>.dropdown-toggle,.navbar .nav .active>.dropdown-toggle,.navbar .nav .open.active>.dropdown-toggle{background-color:transparent;}-.navbar .nav .active>.dropdown-toggle:hover{color:#ffffff;}-.navbar .nav.pull-right .dropdown-menu{left:auto;right:0;}.navbar .nav.pull-right .dropdown-menu:before{left:auto;right:12px;}-.navbar .nav.pull-right .dropdown-menu:after{left:auto;right:13px;}-.breadcrumb{padding:7px 14px;margin:0 0 18px;background-color:#fbfbfb;background-image:-moz-linear-gradient(top, #ffffff, #f5f5f5);background-image:-ms-linear-gradient(top, #ffffff, #f5f5f5);background-image:-webkit-gradient(linear, 0 0, 0 100%, from(#ffffff), to(#f5f5f5));background-image:-webkit-linear-gradient(top, #ffffff, #f5f5f5);background-image:-o-linear-gradient(top, #ffffff, #f5f5f5);background-image:linear-gradient(top, #ffffff, #f5f5f5);background-repeat:repeat-x;filter:progid:DXImageTransform.Microsoft.gradient(startColorstr='#ffffff', endColorstr='#f5f5f5', GradientType=0);border:1px solid #ddd;-webkit-border-radius:3px;-moz-border-radius:3px;border-radius:3px;-webkit-box-shadow:inset 0 1px 0 #ffffff;-moz-box-shadow:inset 0 1px 0 #ffffff;box-shadow:inset 0 1px 0 #ffffff;}.breadcrumb li{display:inline-block;text-shadow:0 1px 0 #ffffff;}-.breadcrumb .divider{padding:0 5px;color:#999999;}-.breadcrumb .active a{color:#333333;}-.pagination{height:36px;margin:18px 0;}-.pagination ul{display:inline-block;*display:inline;*zoom:1;margin-left:0;margin-bottom:0;-webkit-border-radius:3px;-moz-border-radius:3px;border-radius:3px;-webkit-box-shadow:0 1px 2px rgba(0, 0, 0, 0.05);-moz-box-shadow:0 1px 2px rgba(0, 0, 0, 0.05);box-shadow:0 1px 2px rgba(0, 0, 0, 0.05);}-.pagination li{display:inline;}-.pagination a{float:left;padding:0 14px;line-height:34px;text-decoration:none;border:1px solid #ddd;border-left-width:0;}-.pagination a:hover,.pagination .active a{background-color:#f5f5f5;}-.pagination .active a{color:#999999;cursor:default;}-.pagination .disabled a,.pagination .disabled a:hover{color:#999999;background-color:transparent;cursor:default;}-.pagination li:first-child a{border-left-width:1px;-webkit-border-radius:3px 0 0 3px;-moz-border-radius:3px 0 0 3px;border-radius:3px 0 0 3px;}-.pagination li:last-child a{-webkit-border-radius:0 3px 3px 0;-moz-border-radius:0 3px 3px 0;border-radius:0 3px 3px 0;}-.pagination-centered{text-align:center;}-.pagination-right{text-align:right;}-.pager{margin-left:0;margin-bottom:18px;list-style:none;text-align:center;*zoom:1;}.pager:before,.pager:after{display:table;content:"";}-.pager:after{clear:both;}-.pager li{display:inline;}-.pager a{display:inline-block;padding:5px 14px;background-color:#fff;border:1px solid #ddd;-webkit-border-radius:15px;-moz-border-radius:15px;border-radius:15px;}-.pager a:hover{text-decoration:none;background-color:#f5f5f5;}-.pager .next a{float:right;}-.pager .previous a{float:left;}-.modal-open .dropdown-menu{z-index:2050;}-.modal-open .dropdown.open{*z-index:2050;}-.modal-open .popover{z-index:2060;}-.modal-open .tooltip{z-index:2070;}-.modal-backdrop{position:fixed;top:0;right:0;bottom:0;left:0;z-index:1040;background-color:#000000;}.modal-backdrop.fade{opacity:0;}-.modal-backdrop,.modal-backdrop.fade.in{opacity:0.8;filter:alpha(opacity=80);}-.modal{position:fixed;top:50%;left:50%;z-index:1050;max-height:500px;overflow:auto;width:560px;margin:-250px 0 0 -280px;background-color:#ffffff;border:1px solid #999;border:1px solid rgba(0, 0, 0, 0.3);*border:1px solid #999;-webkit-border-radius:6px;-moz-border-radius:6px;border-radius:6px;-webkit-box-shadow:0 3px 7px rgba(0, 0, 0, 0.3);-moz-box-shadow:0 3px 7px rgba(0, 0, 0, 0.3);box-shadow:0 3px 7px rgba(0, 0, 0, 0.3);-webkit-background-clip:padding-box;-moz-background-clip:padding-box;background-clip:padding-box;}.modal.fade{-webkit-transition:opacity .3s linear, top .3s ease-out;-moz-transition:opacity .3s linear, top .3s ease-out;-ms-transition:opacity .3s linear, top .3s ease-out;-o-transition:opacity .3s linear, top .3s ease-out;transition:opacity .3s linear, top .3s ease-out;top:-25%;}-.modal.fade.in{top:50%;}-.modal-header{padding:9px 15px;border-bottom:1px solid #eee;}.modal-header .close{margin-top:2px;}-.modal-body{padding:15px;}-.modal-body .modal-form{margin-bottom:0;}-.modal-footer{padding:14px 15px 15px;margin-bottom:0;background-color:#f5f5f5;border-top:1px solid #ddd;-webkit-border-radius:0 0 6px 6px;-moz-border-radius:0 0 6px 6px;border-radius:0 0 6px 6px;-webkit-box-shadow:inset 0 1px 0 #ffffff;-moz-box-shadow:inset 0 1px 0 #ffffff;box-shadow:inset 0 1px 0 #ffffff;*zoom:1;}.modal-footer:before,.modal-footer:after{display:table;content:"";}-.modal-footer:after{clear:both;}-.modal-footer .btn{float:right;margin-left:5px;margin-bottom:0;}-.tooltip{position:absolute;z-index:1020;display:block;visibility:visible;padding:5px;font-size:11px;opacity:0;filter:alpha(opacity=0);}.tooltip.in{opacity:0.8;filter:alpha(opacity=80);}-.tooltip.top{margin-top:-2px;}-.tooltip.right{margin-left:2px;}-.tooltip.bottom{margin-top:2px;}-.tooltip.left{margin-left:-2px;}-.tooltip.top .tooltip-arrow{bottom:0;left:50%;margin-left:-5px;border-left:5px solid transparent;border-right:5px solid transparent;border-top:5px solid #000000;}-.tooltip.left .tooltip-arrow{top:50%;right:0;margin-top:-5px;border-top:5px solid transparent;border-bottom:5px solid transparent;border-left:5px solid #000000;}-.tooltip.bottom .tooltip-arrow{top:0;left:50%;margin-left:-5px;border-left:5px solid transparent;border-right:5px solid transparent;border-bottom:5px solid #000000;}-.tooltip.right .tooltip-arrow{top:50%;left:0;margin-top:-5px;border-top:5px solid transparent;border-bottom:5px solid transparent;border-right:5px solid #000000;}-.tooltip-inner{max-width:200px;padding:3px 8px;color:#ffffff;text-align:center;text-decoration:none;background-color:#000000;-webkit-border-radius:4px;-moz-border-radius:4px;border-radius:4px;}-.tooltip-arrow{position:absolute;width:0;height:0;}-.popover{position:absolute;top:0;left:0;z-index:1010;display:none;padding:5px;}.popover.top{margin-top:-5px;}-.popover.right{margin-left:5px;}-.popover.bottom{margin-top:5px;}-.popover.left{margin-left:-5px;}-.popover.top .arrow{bottom:0;left:50%;margin-left:-5px;border-left:5px solid transparent;border-right:5px solid transparent;border-top:5px solid #000000;}-.popover.right .arrow{top:50%;left:0;margin-top:-5px;border-top:5px solid transparent;border-bottom:5px solid transparent;border-right:5px solid #000000;}-.popover.bottom .arrow{top:0;left:50%;margin-left:-5px;border-left:5px solid transparent;border-right:5px solid transparent;border-bottom:5px solid #000000;}-.popover.left .arrow{top:50%;right:0;margin-top:-5px;border-top:5px solid transparent;border-bottom:5px solid transparent;border-left:5px solid #000000;}-.popover .arrow{position:absolute;width:0;height:0;}-.popover-inner{padding:3px;width:280px;overflow:hidden;background:#000000;background:rgba(0, 0, 0, 0.8);-webkit-border-radius:6px;-moz-border-radius:6px;border-radius:6px;-webkit-box-shadow:0 3px 7px rgba(0, 0, 0, 0.3);-moz-box-shadow:0 3px 7px rgba(0, 0, 0, 0.3);box-shadow:0 3px 7px rgba(0, 0, 0, 0.3);}-.popover-title{padding:9px 15px;line-height:1;background-color:#f5f5f5;border-bottom:1px solid #eee;-webkit-border-radius:3px 3px 0 0;-moz-border-radius:3px 3px 0 0;border-radius:3px 3px 0 0;}-.popover-content{padding:14px;background-color:#ffffff;-webkit-border-radius:0 0 3px 3px;-moz-border-radius:0 0 3px 3px;border-radius:0 0 3px 3px;-webkit-background-clip:padding-box;-moz-background-clip:padding-box;background-clip:padding-box;}.popover-content p,.popover-content ul,.popover-content ol{margin-bottom:0;}-.thumbnails{margin-left:-20px;list-style:none;*zoom:1;}.thumbnails:before,.thumbnails:after{display:table;content:"";}-.thumbnails:after{clear:both;}-.thumbnails>li{float:left;margin:0 0 18px 20px;}-.thumbnail{display:block;padding:4px;line-height:1;border:1px solid #ddd;-webkit-border-radius:4px;-moz-border-radius:4px;border-radius:4px;-webkit-box-shadow:0 1px 1px rgba(0, 0, 0, 0.075);-moz-box-shadow:0 1px 1px rgba(0, 0, 0, 0.075);box-shadow:0 1px 1px rgba(0, 0, 0, 0.075);}-a.thumbnail:hover{border-color:#0088cc;-webkit-box-shadow:0 1px 4px rgba(0, 105, 214, 0.25);-moz-box-shadow:0 1px 4px rgba(0, 105, 214, 0.25);box-shadow:0 1px 4px rgba(0, 105, 214, 0.25);}-.thumbnail>img{display:block;max-width:100%;margin-left:auto;margin-right:auto;}-.thumbnail .caption{padding:9px;}-.label{padding:2px 4px 3px;font-size:11.049999999999999px;font-weight:bold;color:#ffffff;text-shadow:0 -1px 0 rgba(0, 0, 0, 0.25);background-color:#999999;-webkit-border-radius:3px;-moz-border-radius:3px;border-radius:3px;}-.label:hover{color:#ffffff;text-decoration:none;}-.label-important{background-color:#b94a48;}-.label-important:hover{background-color:#953b39;}-.label-warning{background-color:#f89406;}-.label-warning:hover{background-color:#c67605;}-.label-success{background-color:#468847;}-.label-success:hover{background-color:#356635;}-.label-info{background-color:#3a87ad;}-.label-info:hover{background-color:#2d6987;}-@-webkit-keyframes progress-bar-stripes{from{background-position:0 0;} to{background-position:40px 0;}}@-moz-keyframes progress-bar-stripes{from{background-position:0 0;} to{background-position:40px 0;}}@keyframes progress-bar-stripes{from{background-position:0 0;} to{background-position:40px 0;}}.progress{overflow:hidden;height:18px;margin-bottom:18px;background-color:#f7f7f7;background-image:-moz-linear-gradient(top, #f5f5f5, #f9f9f9);background-image:-ms-linear-gradient(top, #f5f5f5, #f9f9f9);background-image:-webkit-gradient(linear, 0 0, 0 100%, from(#f5f5f5), to(#f9f9f9));background-image:-webkit-linear-gradient(top, #f5f5f5, #f9f9f9);background-image:-o-linear-gradient(top, #f5f5f5, #f9f9f9);background-image:linear-gradient(top, #f5f5f5, #f9f9f9);background-repeat:repeat-x;filter:progid:DXImageTransform.Microsoft.gradient(startColorstr='#f5f5f5', endColorstr='#f9f9f9', GradientType=0);-webkit-box-shadow:inset 0 1px 2px rgba(0, 0, 0, 0.1);-moz-box-shadow:inset 0 1px 2px rgba(0, 0, 0, 0.1);box-shadow:inset 0 1px 2px rgba(0, 0, 0, 0.1);-webkit-border-radius:4px;-moz-border-radius:4px;border-radius:4px;}-.progress .bar{width:0%;height:18px;color:#ffffff;font-size:12px;text-align:center;text-shadow:0 -1px 0 rgba(0, 0, 0, 0.25);background-color:#0e90d2;background-image:-moz-linear-gradient(top, #149bdf, #0480be);background-image:-ms-linear-gradient(top, #149bdf, #0480be);background-image:-webkit-gradient(linear, 0 0, 0 100%, from(#149bdf), to(#0480be));background-image:-webkit-linear-gradient(top, #149bdf, #0480be);background-image:-o-linear-gradient(top, #149bdf, #0480be);background-image:linear-gradient(top, #149bdf, #0480be);background-repeat:repeat-x;filter:progid:DXImageTransform.Microsoft.gradient(startColorstr='#149bdf', endColorstr='#0480be', GradientType=0);-webkit-box-shadow:inset 0 -1px 0 rgba(0, 0, 0, 0.15);-moz-box-shadow:inset 0 -1px 0 rgba(0, 0, 0, 0.15);box-shadow:inset 0 -1px 0 rgba(0, 0, 0, 0.15);-webkit-box-sizing:border-box;-moz-box-sizing:border-box;box-sizing:border-box;-webkit-transition:width 0.6s ease;-moz-transition:width 0.6s ease;-ms-transition:width 0.6s ease;-o-transition:width 0.6s ease;transition:width 0.6s ease;}-.progress-striped .bar{background-color:#62c462;background-image:-webkit-gradient(linear, 0 100%, 100% 0, color-stop(0.25, rgba(255, 255, 255, 0.15)), color-stop(0.25, transparent), color-stop(0.5, transparent), color-stop(0.5, rgba(255, 255, 255, 0.15)), color-stop(0.75, rgba(255, 255, 255, 0.15)), color-stop(0.75, transparent), to(transparent));background-image:-webkit-linear-gradient(-45deg, rgba(255, 255, 255, 0.15) 25%, transparent 25%, transparent 50%, rgba(255, 255, 255, 0.15) 50%, rgba(255, 255, 255, 0.15) 75%, transparent 75%, transparent);background-image:-moz-linear-gradient(-45deg, rgba(255, 255, 255, 0.15) 25%, transparent 25%, transparent 50%, rgba(255, 255, 255, 0.15) 50%, rgba(255, 255, 255, 0.15) 75%, transparent 75%, transparent);background-image:-ms-linear-gradient(-45deg, rgba(255, 255, 255, 0.15) 25%, transparent 25%, transparent 50%, rgba(255, 255, 255, 0.15) 50%, rgba(255, 255, 255, 0.15) 75%, transparent 75%, transparent);background-image:-o-linear-gradient(-45deg, rgba(255, 255, 255, 0.15) 25%, transparent 25%, transparent 50%, rgba(255, 255, 255, 0.15) 50%, rgba(255, 255, 255, 0.15) 75%, transparent 75%, transparent);background-image:linear-gradient(-45deg, rgba(255, 255, 255, 0.15) 25%, transparent 25%, transparent 50%, rgba(255, 255, 255, 0.15) 50%, rgba(255, 255, 255, 0.15) 75%, transparent 75%, transparent);-webkit-background-size:40px 40px;-moz-background-size:40px 40px;-o-background-size:40px 40px;background-size:40px 40px;}-.progress.active .bar{-webkit-animation:progress-bar-stripes 2s linear infinite;-moz-animation:progress-bar-stripes 2s linear infinite;animation:progress-bar-stripes 2s linear infinite;}-.progress-danger .bar{background-color:#dd514c;background-image:-moz-linear-gradient(top, #ee5f5b, #c43c35);background-image:-ms-linear-gradient(top, #ee5f5b, #c43c35);background-image:-webkit-gradient(linear, 0 0, 0 100%, from(#ee5f5b), to(#c43c35));background-image:-webkit-linear-gradient(top, #ee5f5b, #c43c35);background-image:-o-linear-gradient(top, #ee5f5b, #c43c35);background-image:linear-gradient(top, #ee5f5b, #c43c35);background-repeat:repeat-x;filter:progid:DXImageTransform.Microsoft.gradient(startColorstr='#ee5f5b', endColorstr='#c43c35', GradientType=0);}-.progress-danger.progress-striped .bar{background-color:#ee5f5b;background-image:-webkit-gradient(linear, 0 100%, 100% 0, color-stop(0.25, rgba(255, 255, 255, 0.15)), color-stop(0.25, transparent), color-stop(0.5, transparent), color-stop(0.5, rgba(255, 255, 255, 0.15)), color-stop(0.75, rgba(255, 255, 255, 0.15)), color-stop(0.75, transparent), to(transparent));background-image:-webkit-linear-gradient(-45deg, rgba(255, 255, 255, 0.15) 25%, transparent 25%, transparent 50%, rgba(255, 255, 255, 0.15) 50%, rgba(255, 255, 255, 0.15) 75%, transparent 75%, transparent);background-image:-moz-linear-gradient(-45deg, rgba(255, 255, 255, 0.15) 25%, transparent 25%, transparent 50%, rgba(255, 255, 255, 0.15) 50%, rgba(255, 255, 255, 0.15) 75%, transparent 75%, transparent);background-image:-ms-linear-gradient(-45deg, rgba(255, 255, 255, 0.15) 25%, transparent 25%, transparent 50%, rgba(255, 255, 255, 0.15) 50%, rgba(255, 255, 255, 0.15) 75%, transparent 75%, transparent);background-image:-o-linear-gradient(-45deg, rgba(255, 255, 255, 0.15) 25%, transparent 25%, transparent 50%, rgba(255, 255, 255, 0.15) 50%, rgba(255, 255, 255, 0.15) 75%, transparent 75%, transparent);background-image:linear-gradient(-45deg, rgba(255, 255, 255, 0.15) 25%, transparent 25%, transparent 50%, rgba(255, 255, 255, 0.15) 50%, rgba(255, 255, 255, 0.15) 75%, transparent 75%, transparent);}-.progress-success .bar{background-color:#5eb95e;background-image:-moz-linear-gradient(top, #62c462, #57a957);background-image:-ms-linear-gradient(top, #62c462, #57a957);background-image:-webkit-gradient(linear, 0 0, 0 100%, from(#62c462), to(#57a957));background-image:-webkit-linear-gradient(top, #62c462, #57a957);background-image:-o-linear-gradient(top, #62c462, #57a957);background-image:linear-gradient(top, #62c462, #57a957);background-repeat:repeat-x;filter:progid:DXImageTransform.Microsoft.gradient(startColorstr='#62c462', endColorstr='#57a957', GradientType=0);}-.progress-success.progress-striped .bar{background-color:#62c462;background-image:-webkit-gradient(linear, 0 100%, 100% 0, color-stop(0.25, rgba(255, 255, 255, 0.15)), color-stop(0.25, transparent), color-stop(0.5, transparent), color-stop(0.5, rgba(255, 255, 255, 0.15)), color-stop(0.75, rgba(255, 255, 255, 0.15)), color-stop(0.75, transparent), to(transparent));background-image:-webkit-linear-gradient(-45deg, rgba(255, 255, 255, 0.15) 25%, transparent 25%, transparent 50%, rgba(255, 255, 255, 0.15) 50%, rgba(255, 255, 255, 0.15) 75%, transparent 75%, transparent);background-image:-moz-linear-gradient(-45deg, rgba(255, 255, 255, 0.15) 25%, transparent 25%, transparent 50%, rgba(255, 255, 255, 0.15) 50%, rgba(255, 255, 255, 0.15) 75%, transparent 75%, transparent);background-image:-ms-linear-gradient(-45deg, rgba(255, 255, 255, 0.15) 25%, transparent 25%, transparent 50%, rgba(255, 255, 255, 0.15) 50%, rgba(255, 255, 255, 0.15) 75%, transparent 75%, transparent);background-image:-o-linear-gradient(-45deg, rgba(255, 255, 255, 0.15) 25%, transparent 25%, transparent 50%, rgba(255, 255, 255, 0.15) 50%, rgba(255, 255, 255, 0.15) 75%, transparent 75%, transparent);background-image:linear-gradient(-45deg, rgba(255, 255, 255, 0.15) 25%, transparent 25%, transparent 50%, rgba(255, 255, 255, 0.15) 50%, rgba(255, 255, 255, 0.15) 75%, transparent 75%, transparent);}-.progress-info .bar{background-color:#4bb1cf;background-image:-moz-linear-gradient(top, #5bc0de, #339bb9);background-image:-ms-linear-gradient(top, #5bc0de, #339bb9);background-image:-webkit-gradient(linear, 0 0, 0 100%, from(#5bc0de), to(#339bb9));background-image:-webkit-linear-gradient(top, #5bc0de, #339bb9);background-image:-o-linear-gradient(top, #5bc0de, #339bb9);background-image:linear-gradient(top, #5bc0de, #339bb9);background-repeat:repeat-x;filter:progid:DXImageTransform.Microsoft.gradient(startColorstr='#5bc0de', endColorstr='#339bb9', GradientType=0);}-.progress-info.progress-striped .bar{background-color:#5bc0de;background-image:-webkit-gradient(linear, 0 100%, 100% 0, color-stop(0.25, rgba(255, 255, 255, 0.15)), color-stop(0.25, transparent), color-stop(0.5, transparent), color-stop(0.5, rgba(255, 255, 255, 0.15)), color-stop(0.75, rgba(255, 255, 255, 0.15)), color-stop(0.75, transparent), to(transparent));background-image:-webkit-linear-gradient(-45deg, rgba(255, 255, 255, 0.15) 25%, transparent 25%, transparent 50%, rgba(255, 255, 255, 0.15) 50%, rgba(255, 255, 255, 0.15) 75%, transparent 75%, transparent);background-image:-moz-linear-gradient(-45deg, rgba(255, 255, 255, 0.15) 25%, transparent 25%, transparent 50%, rgba(255, 255, 255, 0.15) 50%, rgba(255, 255, 255, 0.15) 75%, transparent 75%, transparent);background-image:-ms-linear-gradient(-45deg, rgba(255, 255, 255, 0.15) 25%, transparent 25%, transparent 50%, rgba(255, 255, 255, 0.15) 50%, rgba(255, 255, 255, 0.15) 75%, transparent 75%, transparent);background-image:-o-linear-gradient(-45deg, rgba(255, 255, 255, 0.15) 25%, transparent 25%, transparent 50%, rgba(255, 255, 255, 0.15) 50%, rgba(255, 255, 255, 0.15) 75%, transparent 75%, transparent);background-image:linear-gradient(-45deg, rgba(255, 255, 255, 0.15) 25%, transparent 25%, transparent 50%, rgba(255, 255, 255, 0.15) 50%, rgba(255, 255, 255, 0.15) 75%, transparent 75%, transparent);}-.accordion{margin-bottom:18px;}-.accordion-group{margin-bottom:2px;border:1px solid #e5e5e5;-webkit-border-radius:4px;-moz-border-radius:4px;border-radius:4px;}-.accordion-heading{border-bottom:0;}-.accordion-heading .accordion-toggle{display:block;padding:8px 15px;}-.accordion-inner{padding:9px 15px;border-top:1px solid #e5e5e5;}-.carousel{position:relative;margin-bottom:18px;line-height:1;}-.carousel-inner{overflow:hidden;width:100%;position:relative;}-.carousel .item{display:none;position:relative;-webkit-transition:0.6s ease-in-out left;-moz-transition:0.6s ease-in-out left;-ms-transition:0.6s ease-in-out left;-o-transition:0.6s ease-in-out left;transition:0.6s ease-in-out left;}-.carousel .item>img{display:block;line-height:1;}-.carousel .active,.carousel .next,.carousel .prev{display:block;}-.carousel .active{left:0;}-.carousel .next,.carousel .prev{position:absolute;top:0;width:100%;}-.carousel .next{left:100%;}-.carousel .prev{left:-100%;}-.carousel .next.left,.carousel .prev.right{left:0;}-.carousel .active.left{left:-100%;}-.carousel .active.right{left:100%;}-.carousel-control{position:absolute;top:40%;left:15px;width:40px;height:40px;margin-top:-20px;font-size:60px;font-weight:100;line-height:30px;color:#ffffff;text-align:center;background:#222222;border:3px solid #ffffff;-webkit-border-radius:23px;-moz-border-radius:23px;border-radius:23px;opacity:0.5;filter:alpha(opacity=50);}.carousel-control.right{left:auto;right:15px;}-.carousel-control:hover{color:#ffffff;text-decoration:none;opacity:0.9;filter:alpha(opacity=90);}-.carousel-caption{position:absolute;left:0;right:0;bottom:0;padding:10px 15px 5px;background:#333333;background:rgba(0, 0, 0, 0.75);}-.carousel-caption h4,.carousel-caption p{color:#ffffff;}-.hero-unit{padding:60px;margin-bottom:30px;background-color:#f5f5f5;-webkit-border-radius:6px;-moz-border-radius:6px;border-radius:6px;}.hero-unit h1{margin-bottom:0;font-size:60px;line-height:1;letter-spacing:-1px;}-.hero-unit p{font-size:18px;font-weight:200;line-height:27px;}-.pull-right{float:right;}-.pull-left{float:left;}-.hide{display:none;}-.show{display:block;}-.invisible{visibility:hidden;}
− html/bootstrap.min.js
@@ -1,1 +0,0 @@-!function(a){a(function(){"use strict",a.support.transition=function(){var b=document.body||document.documentElement,c=b.style,d=c.transition!==undefined||c.WebkitTransition!==undefined||c.MozTransition!==undefined||c.MsTransition!==undefined||c.OTransition!==undefined;return d&&{end:function(){var b="TransitionEnd";return a.browser.webkit?b="webkitTransitionEnd":a.browser.mozilla?b="transitionend":a.browser.opera&&(b="oTransitionEnd"),b}()}}()})}(window.jQuery),!function(a){"use strict";var b='[data-dismiss="alert"]',c=function(c){a(c).on("click",b,this.close)};c.prototype={constructor:c,close:function(b){function f(){e.trigger("closed").remove()}var c=a(this),d=c.attr("data-target"),e;d||(d=c.attr("href"),d=d&&d.replace(/.*(?=#[^\s]*$)/,"")),e=a(d),e.trigger("close"),b&&b.preventDefault(),e.length||(e=c.hasClass("alert")?c:c.parent()),e.trigger("close").removeClass("in"),a.support.transition&&e.hasClass("fade")?e.on(a.support.transition.end,f):f()}},a.fn.alert=function(b){return this.each(function(){var d=a(this),e=d.data("alert");e||d.data("alert",e=new c(this)),typeof b=="string"&&e[b].call(d)})},a.fn.alert.Constructor=c,a(function(){a("body").on("click.alert.data-api",b,c.prototype.close)})}(window.jQuery),!function(a){"use strict";var b=function(b,c){this.$element=a(b),this.options=a.extend({},a.fn.button.defaults,c)};b.prototype={constructor:b,setState:function(a){var b="disabled",c=this.$element,d=c.data(),e=c.is("input")?"val":"html";a+="Text",d.resetText||c.data("resetText",c[e]()),c[e](d[a]||this.options[a]),setTimeout(function(){a=="loadingText"?c.addClass(b).attr(b,b):c.removeClass(b).removeAttr(b)},0)},toggle:function(){var a=this.$element.parent('[data-toggle="buttons-radio"]');a&&a.find(".active").removeClass("active"),this.$element.toggleClass("active")}},a.fn.button=function(c){return this.each(function(){var d=a(this),e=d.data("button"),f=typeof c=="object"&&c;e||d.data("button",e=new b(this,f)),c=="toggle"?e.toggle():c&&e.setState(c)})},a.fn.button.defaults={loadingText:"loading..."},a.fn.button.Constructor=b,a(function(){a("body").on("click.button.data-api","[data-toggle^=button]",function(b){var c=a(b.target);c.hasClass("btn")||(c=c.closest(".btn")),c.button("toggle")})})}(window.jQuery),!function(a){"use strict";var b=function(b,c){this.$element=a(b),this.options=a.extend({},a.fn.carousel.defaults,c),this.options.slide&&this.slide(this.options.slide)};b.prototype={cycle:function(){return this.interval=setInterval(a.proxy(this.next,this),this.options.interval),this},to:function(b){var c=this.$element.find(".active"),d=c.parent().children(),e=d.index(c),f=this;if(b>d.length-1||b<0)return;return this.sliding?this.$element.one("slid",function(){f.to(b)}):e==b?this.pause().cycle():this.slide(b>e?"next":"prev",a(d[b]))},pause:function(){return clearInterval(this.interval),this.interval=null,this},next:function(){if(this.sliding)return;return this.slide("next")},prev:function(){if(this.sliding)return;return this.slide("prev")},slide:function(b,c){var d=this.$element.find(".active"),e=c||d[b](),f=this.interval,g=b=="next"?"left":"right",h=b=="next"?"first":"last",i=this;if(!e.length)return;return this.sliding=!0,f&&this.pause(),e=e.length?e:this.$element.find(".item")[h](),!a.support.transition&&this.$element.hasClass("slide")?(this.$element.trigger("slide"),d.removeClass("active"),e.addClass("active"),this.sliding=!1,this.$element.trigger("slid")):(e.addClass(b),e[0].offsetWidth,d.addClass(g),e.addClass(g),this.$element.trigger("slide"),this.$element.one(a.support.transition.end,function(){e.removeClass([b,g].join(" ")).addClass("active"),d.removeClass(["active",g].join(" ")),i.sliding=!1,setTimeout(function(){i.$element.trigger("slid")},0)})),f&&this.cycle(),this}},a.fn.carousel=function(c){return this.each(function(){var d=a(this),e=d.data("carousel"),f=typeof c=="object"&&c;e||d.data("carousel",e=new b(this,f)),typeof c=="number"?e.to(c):typeof c=="string"||(c=f.slide)?e[c]():e.cycle()})},a.fn.carousel.defaults={interval:5e3},a.fn.carousel.Constructor=b,a(function(){a("body").on("click.carousel.data-api","[data-slide]",function(b){var c=a(this),d,e=a(c.attr("data-target")||(d=c.attr("href"))&&d.replace(/.*(?=#[^\s]+$)/,"")),f=!e.data("modal")&&a.extend({},e.data(),c.data());e.carousel(f),b.preventDefault()})})}(window.jQuery),!function(a){"use strict";var b=function(b,c){this.$element=a(b),this.options=a.extend({},a.fn.collapse.defaults,c),this.options.parent&&(this.$parent=a(this.options.parent)),this.options.toggle&&this.toggle()};b.prototype={constructor:b,dimension:function(){var a=this.$element.hasClass("width");return a?"width":"height"},show:function(){var b=this.dimension(),c=a.camelCase(["scroll",b].join("-")),d=this.$parent&&this.$parent.find(".in"),e;d&&d.length&&(e=d.data("collapse"),d.collapse("hide"),e||d.data("collapse",null)),this.$element[b](0),this.transition("addClass","show","shown"),this.$element[b](this.$element[0][c])},hide:function(){var a=this.dimension();this.reset(this.$element[a]()),this.transition("removeClass","hide","hidden"),this.$element[a](0)},reset:function(a){var b=this.dimension();this.$element.removeClass("collapse")[b](a||"auto")[0].offsetWidth,this.$element.addClass("collapse")},transition:function(b,c,d){var e=this,f=function(){c=="show"&&e.reset(),e.$element.trigger(d)};this.$element.trigger(c)[b]("in"),a.support.transition&&this.$element.hasClass("collapse")?this.$element.one(a.support.transition.end,f):f()},toggle:function(){this[this.$element.hasClass("in")?"hide":"show"]()}},a.fn.collapse=function(c){return this.each(function(){var d=a(this),e=d.data("collapse"),f=typeof c=="object"&&c;e||d.data("collapse",e=new b(this,f)),typeof c=="string"&&e[c]()})},a.fn.collapse.defaults={toggle:!0},a.fn.collapse.Constructor=b,a(function(){a("body").on("click.collapse.data-api","[data-toggle=collapse]",function(b){var c=a(this),d,e=c.attr("data-target")||b.preventDefault()||(d=c.attr("href"))&&d.replace(/.*(?=#[^\s]+$)/,""),f=a(e).data("collapse")?"toggle":c.data();a(e).collapse(f)})})}(window.jQuery),!function(a){function d(){a(b).parent().removeClass("open")}"use strict";var b='[data-toggle="dropdown"]',c=function(b){var c=a(b).on("click.dropdown.data-api",this.toggle);a("html").on("click.dropdown.data-api",function(){c.parent().removeClass("open")})};c.prototype={constructor:c,toggle:function(b){var c=a(this),e=c.attr("data-target"),f,g;return e||(e=c.attr("href"),e=e&&e.replace(/.*(?=#[^\s]*$)/,"")),f=a(e),f.length||(f=c.parent()),g=f.hasClass("open"),d(),!g&&f.toggleClass("open"),!1}},a.fn.dropdown=function(b){return this.each(function(){var d=a(this),e=d.data("dropdown");e||d.data("dropdown",e=new c(this)),typeof b=="string"&&e[b].call(d)})},a.fn.dropdown.Constructor=c,a(function(){a("html").on("click.dropdown.data-api",d),a("body").on("click.dropdown.data-api",b,c.prototype.toggle)})}(window.jQuery),!function(a){function c(){var b=this,c=setTimeout(function(){b.$element.off(a.support.transition.end),d.call(b)},500);this.$element.one(a.support.transition.end,function(){clearTimeout(c),d.call(b)})}function d(a){this.$element.hide().trigger("hidden"),e.call(this)}function e(b){var c=this,d=this.$element.hasClass("fade")?"fade":"";if(this.isShown&&this.options.backdrop){var e=a.support.transition&&d;this.$backdrop=a('<div class="modal-backdrop '+d+'" />').appendTo(document.body),this.options.backdrop!="static"&&this.$backdrop.click(a.proxy(this.hide,this)),e&&this.$backdrop[0].offsetWidth,this.$backdrop.addClass("in"),e?this.$backdrop.one(a.support.transition.end,b):b()}else!this.isShown&&this.$backdrop?(this.$backdrop.removeClass("in"),a.support.transition&&this.$element.hasClass("fade")?this.$backdrop.one(a.support.transition.end,a.proxy(f,this)):f.call(this)):b&&b()}function f(){this.$backdrop.remove(),this.$backdrop=null}function g(){var b=this;this.isShown&&this.options.keyboard?a(document).on("keyup.dismiss.modal",function(a){a.which==27&&b.hide()}):this.isShown||a(document).off("keyup.dismiss.modal")}"use strict";var b=function(b,c){this.options=c,this.$element=a(b).delegate('[data-dismiss="modal"]',"click.dismiss.modal",a.proxy(this.hide,this))};b.prototype={constructor:b,toggle:function(){return this[this.isShown?"hide":"show"]()},show:function(){var b=this;if(this.isShown)return;a("body").addClass("modal-open"),this.isShown=!0,this.$element.trigger("show"),g.call(this),e.call(this,function(){var c=a.support.transition&&b.$element.hasClass("fade");!b.$element.parent().length&&b.$element.appendTo(document.body),b.$element.show(),c&&b.$element[0].offsetWidth,b.$element.addClass("in"),c?b.$element.one(a.support.transition.end,function(){b.$element.trigger("shown")}):b.$element.trigger("shown")})},hide:function(b){b&&b.preventDefault();if(!this.isShown)return;var e=this;this.isShown=!1,a("body").removeClass("modal-open"),g.call(this),this.$element.trigger("hide").removeClass("in"),a.support.transition&&this.$element.hasClass("fade")?c.call(this):d.call(this)}},a.fn.modal=function(c){return this.each(function(){var d=a(this),e=d.data("modal"),f=a.extend({},a.fn.modal.defaults,d.data(),typeof c=="object"&&c);e||d.data("modal",e=new b(this,f)),typeof c=="string"?e[c]():f.show&&e.show()})},a.fn.modal.defaults={backdrop:!0,keyboard:!0,show:!0},a.fn.modal.Constructor=b,a(function(){a("body").on("click.modal.data-api",'[data-toggle="modal"]',function(b){var c=a(this),d,e=a(c.attr("data-target")||(d=c.attr("href"))&&d.replace(/.*(?=#[^\s]+$)/,"")),f=e.data("modal")?"toggle":a.extend({},e.data(),c.data());b.preventDefault(),e.modal(f)})})}(window.jQuery),!function(a){"use strict";var b=function(a,b){this.init("tooltip",a,b)};b.prototype={constructor:b,init:function(b,c,d){var e,f;this.type=b,this.$element=a(c),this.options=this.getOptions(d),this.enabled=!0,this.options.trigger!="manual"&&(e=this.options.trigger=="hover"?"mouseenter":"focus",f=this.options.trigger=="hover"?"mouseleave":"blur",this.$element.on(e,this.options.selector,a.proxy(this.enter,this)),this.$element.on(f,this.options.selector,a.proxy(this.leave,this))),this.options.selector?this._options=a.extend({},this.options,{trigger:"manual",selector:""}):this.fixTitle()},getOptions:function(b){return b=a.extend({},a.fn[this.type].defaults,b,this.$element.data()),b.delay&&typeof b.delay=="number"&&(b.delay={show:b.delay,hide:b.delay}),b},enter:function(b){var c=a(b.currentTarget)[this.type](this._options).data(this.type);!c.options.delay||!c.options.delay.show?c.show():(c.hoverState="in",setTimeout(function(){c.hoverState=="in"&&c.show()},c.options.delay.show))},leave:function(b){var c=a(b.currentTarget)[this.type](this._options).data(this.type);!c.options.delay||!c.options.delay.hide?c.hide():(c.hoverState="out",setTimeout(function(){c.hoverState=="out"&&c.hide()},c.options.delay.hide))},show:function(){var a,b,c,d,e,f,g;if(this.hasContent()&&this.enabled){a=this.tip(),this.setContent(),this.options.animation&&a.addClass("fade"),f=typeof this.options.placement=="function"?this.options.placement.call(this,a[0],this.$element[0]):this.options.placement,b=/in/.test(f),a.remove().css({top:0,left:0,display:"block"}).appendTo(b?this.$element:document.body),c=this.getPosition(b),d=a[0].offsetWidth,e=a[0].offsetHeight;switch(b?f.split(" ")[1]:f){case"bottom":g={top:c.top+c.height,left:c.left+c.width/2-d/2};break;case"top":g={top:c.top-e,left:c.left+c.width/2-d/2};break;case"left":g={top:c.top+c.height/2-e/2,left:c.left-d};break;case"right":g={top:c.top+c.height/2-e/2,left:c.left+c.width}}a.css(g).addClass(f).addClass("in")}},setContent:function(){var a=this.tip();a.find(".tooltip-inner").html(this.getTitle()),a.removeClass("fade in top bottom left right")},hide:function(){function d(){var b=setTimeout(function(){c.off(a.support.transition.end).remove()},500);c.one(a.support.transition.end,function(){clearTimeout(b),c.remove()})}var b=this,c=this.tip();c.removeClass("in"),a.support.transition&&this.$tip.hasClass("fade")?d():c.remove()},fixTitle:function(){var a=this.$element;(a.attr("title")||typeof a.attr("data-original-title")!="string")&&a.attr("data-original-title",a.attr("title")||"").removeAttr("title")},hasContent:function(){return this.getTitle()},getPosition:function(b){return a.extend({},b?{top:0,left:0}:this.$element.offset(),{width:this.$element[0].offsetWidth,height:this.$element[0].offsetHeight})},getTitle:function(){var a,b=this.$element,c=this.options;return a=b.attr("data-original-title")||(typeof c.title=="function"?c.title.call(b[0]):c.title),a=a.toString().replace(/(^\s*|\s*$)/,""),a},tip:function(){return this.$tip=this.$tip||a(this.options.template)},validate:function(){this.$element[0].parentNode||(this.hide(),this.$element=null,this.options=null)},enable:function(){this.enabled=!0},disable:function(){this.enabled=!1},toggleEnabled:function(){this.enabled=!this.enabled},toggle:function(){this[this.tip().hasClass("in")?"hide":"show"]()}},a.fn.tooltip=function(c){return this.each(function(){var d=a(this),e=d.data("tooltip"),f=typeof c=="object"&&c;e||d.data("tooltip",e=new b(this,f)),typeof c=="string"&&e[c]()})},a.fn.tooltip.Constructor=b,a.fn.tooltip.defaults={animation:!0,delay:0,selector:!1,placement:"top",trigger:"hover",title:"",template:'<div class="tooltip"><div class="tooltip-arrow"></div><div class="tooltip-inner"></div></div>'}}(window.jQuery),!function(a){"use strict";var b=function(a,b){this.init("popover",a,b)};b.prototype=a.extend({},a.fn.tooltip.Constructor.prototype,{constructor:b,setContent:function(){var b=this.tip(),c=this.getTitle(),d=this.getContent();b.find(".popover-title")[a.type(c)=="object"?"append":"html"](c),b.find(".popover-content > *")[a.type(d)=="object"?"append":"html"](d),b.removeClass("fade top bottom left right in")},hasContent:function(){return this.getTitle()||this.getContent()},getContent:function(){var a,b=this.$element,c=this.options;return a=b.attr("data-content")||(typeof c.content=="function"?c.content.call(b[0]):c.content),a=a.toString().replace(/(^\s*|\s*$)/,""),a},tip:function(){return this.$tip||(this.$tip=a(this.options.template)),this.$tip}}),a.fn.popover=function(c){return this.each(function(){var d=a(this),e=d.data("popover"),f=typeof c=="object"&&c;e||d.data("popover",e=new b(this,f)),typeof c=="string"&&e[c]()})},a.fn.popover.Constructor=b,a.fn.popover.defaults=a.extend({},a.fn.tooltip.defaults,{placement:"right",content:"",template:'<div class="popover"><div class="arrow"></div><div class="popover-inner"><h3 class="popover-title"></h3><div class="popover-content"><p></p></div></div></div>'})}(window.jQuery),!function(a){function b(b,c){var d=a.proxy(this.process,this),e=a(b).is("body")?a(window):a(b),f;this.options=a.extend({},a.fn.scrollspy.defaults,c),this.$scrollElement=e.on("scroll.scroll.data-api",d),this.selector=(this.options.target||(f=a(b).attr("href"))&&f.replace(/.*(?=#[^\s]+$)/,"")||"")+" .nav li > a",this.$body=a("body").on("click.scroll.data-api",this.selector,d),this.refresh(),this.process()}"use strict",b.prototype={constructor:b,refresh:function(){this.targets=this.$body.find(this.selector).map(function(){var b=a(this).attr("href");return/^#\w/.test(b)&&a(b).length?b:null}),this.offsets=a.map(this.targets,function(b){return a(b).position().top})},process:function(){var a=this.$scrollElement.scrollTop()+this.options.offset,b=this.offsets,c=this.targets,d=this.activeTarget,e;for(e=b.length;e--;)d!=c[e]&&a>=b[e]&&(!b[e+1]||a<=b[e+1])&&this.activate(c[e])},activate:function(a){var b;this.activeTarget=a,this.$body.find(this.selector).parent(".active").removeClass("active"),b=this.$body.find(this.selector+'[href="'+a+'"]').parent("li").addClass("active"),b.parent(".dropdown-menu")&&b.closest("li.dropdown").addClass("active")}},a.fn.scrollspy=function(c){return this.each(function(){var d=a(this),e=d.data("scrollspy"),f=typeof c=="object"&&c;e||d.data("scrollspy",e=new b(this,f)),typeof c=="string"&&e[c]()})},a.fn.scrollspy.Constructor=b,a.fn.scrollspy.defaults={offset:10},a(function(){a('[data-spy="scroll"]').each(function(){var b=a(this);b.scrollspy(b.data())})})}(window.jQuery),!function(a){"use strict";var b=function(b){this.element=a(b)};b.prototype={constructor:b,show:function(){var b=this.element,c=b.closest("ul:not(.dropdown-menu)"),d=b.attr("data-target"),e,f;d||(d=b.attr("href"),d=d&&d.replace(/.*(?=#[^\s]*$)/,""));if(b.parent("li").hasClass("active"))return;e=c.find(".active a").last()[0],b.trigger({type:"show",relatedTarget:e}),f=a(d),this.activate(b.parent("li"),c),this.activate(f,f.parent(),function(){b.trigger({type:"shown",relatedTarget:e})})},activate:function(b,c,d){function g(){e.removeClass("active").find("> .dropdown-menu > .active").removeClass("active"),b.addClass("active"),f?(b[0].offsetWidth,b.addClass("in")):b.removeClass("fade"),b.parent(".dropdown-menu")&&b.closest("li.dropdown").addClass("active"),d&&d()}var e=c.find("> .active"),f=d&&a.support.transition&&e.hasClass("fade");f?e.one(a.support.transition.end,g):g(),e.removeClass("in")}},a.fn.tab=function(c){return this.each(function(){var d=a(this),e=d.data("tab");e||d.data("tab",e=new b(this)),typeof c=="string"&&e[c]()})},a.fn.tab.Constructor=b,a(function(){a("body").on("click.tab.data-api",'[data-toggle="tab"], [data-toggle="pill"]',function(b){b.preventDefault(),a(this).tab("show")})})}(window.jQuery),!function(a){"use strict";var b=function(b,c){this.$element=a(b),this.options=a.extend({},a.fn.typeahead.defaults,c),this.matcher=this.options.matcher||this.matcher,this.sorter=this.options.sorter||this.sorter,this.highlighter=this.options.highlighter||this.highlighter,this.$menu=a(this.options.menu).appendTo("body"),this.source=this.options.source,this.shown=!1,this.listen()};b.prototype={constructor:b,select:function(){var a=this.$menu.find(".active").attr("data-value");return this.$element.val(a),this.hide()},show:function(){var b=a.extend({},this.$element.offset(),{height:this.$element[0].offsetHeight});return this.$menu.css({top:b.top+b.height,left:b.left}),this.$menu.show(),this.shown=!0,this},hide:function(){return this.$menu.hide(),this.shown=!1,this},lookup:function(b){var c=this,d,e;return this.query=this.$element.val(),this.query?(d=a.grep(this.source,function(a){if(c.matcher(a))return a}),d=this.sorter(d),d.length?this.render(d.slice(0,this.options.items)).show():this.shown?this.hide():this):this.shown?this.hide():this},matcher:function(a){return~a.toLowerCase().indexOf(this.query.toLowerCase())},sorter:function(a){var b=[],c=[],d=[],e;while(e=a.shift())e.toLowerCase().indexOf(this.query.toLowerCase())?~e.indexOf(this.query)?c.push(e):d.push(e):b.push(e);return b.concat(c,d)},highlighter:function(a){return a.replace(new RegExp("("+this.query+")","ig"),function(a,b){return"<strong>"+b+"</strong>"})},render:function(b){var c=this;return b=a(b).map(function(b,d){return b=a(c.options.item).attr("data-value",d),b.find("a").html(c.highlighter(d)),b[0]}),b.first().addClass("active"),this.$menu.html(b),this},next:function(b){var c=this.$menu.find(".active").removeClass("active"),d=c.next();d.length||(d=a(this.$menu.find("li")[0])),d.addClass("active")},prev:function(a){var b=this.$menu.find(".active").removeClass("active"),c=b.prev();c.length||(c=this.$menu.find("li").last()),c.addClass("active")},listen:function(){this.$element.on("blur",a.proxy(this.blur,this)).on("keypress",a.proxy(this.keypress,this)).on("keyup",a.proxy(this.keyup,this)),(a.browser.webkit||a.browser.msie)&&this.$element.on("keydown",a.proxy(this.keypress,this)),this.$menu.on("click",a.proxy(this.click,this)).on("mouseenter","li",a.proxy(this.mouseenter,this))},keyup:function(a){a.stopPropagation(),a.preventDefault();switch(a.keyCode){case 40:case 38:break;case 9:case 13:if(!this.shown)return;this.select();break;case 27:this.hide();break;default:this.lookup()}},keypress:function(a){a.stopPropagation();if(!this.shown)return;switch(a.keyCode){case 9:case 13:case 27:a.preventDefault();break;case 38:a.preventDefault(),this.prev();break;case 40:a.preventDefault(),this.next()}},blur:function(a){var b=this;a.stopPropagation(),a.preventDefault(),setTimeout(function(){b.hide()},150)},click:function(a){a.stopPropagation(),a.preventDefault(),this.select()},mouseenter:function(b){this.$menu.find(".active").removeClass("active"),a(b.currentTarget).addClass("active")}},a.fn.typeahead=function(c){return this.each(function(){var d=a(this),e=d.data("typeahead"),f=typeof c=="object"&&c;e||d.data("typeahead",e=new b(this,f)),typeof c=="string"&&e[c]()})},a.fn.typeahead.defaults={source:[],items:8,menu:'<ul class="typeahead dropdown-menu"></ul>',item:'<li><a href="#"></a></li>'},a.fn.typeahead.Constructor=b,a(function(){a("body").on("focus.typeahead.data-api",'[data-provide="typeahead"]',function(b){var c=a(this);if(c.data("typeahead"))return;b.preventDefault(),c.typeahead(c.data())})})}(window.jQuery);
− html/glyphicons-halflings-white.png

binary file changed (4352 → absent bytes)

− html/glyphicons-halflings.png

binary file changed (4352 → absent bytes)

− html/jquery-1.6.4.min.js
@@ -1,4 +0,0 @@-/*! jQuery v1.6.4 http://jquery.com/ | http://jquery.org/license */-(function(a,b){function cu(a){return f.isWindow(a)?a:a.nodeType===9?a.defaultView||a.parentWindow:!1}function cr(a){if(!cg[a]){var b=c.body,d=f("<"+a+">").appendTo(b),e=d.css("display");d.remove();if(e==="none"||e===""){ch||(ch=c.createElement("iframe"),ch.frameBorder=ch.width=ch.height=0),b.appendChild(ch);if(!ci||!ch.createElement)ci=(ch.contentWindow||ch.contentDocument).document,ci.write((c.compatMode==="CSS1Compat"?"<!doctype html>":"")+"<html><body>"),ci.close();d=ci.createElement(a),ci.body.appendChild(d),e=f.css(d,"display"),b.removeChild(ch)}cg[a]=e}return cg[a]}function cq(a,b){var c={};f.each(cm.concat.apply([],cm.slice(0,b)),function(){c[this]=a});return c}function cp(){cn=b}function co(){setTimeout(cp,0);return cn=f.now()}function cf(){try{return new a.ActiveXObject("Microsoft.XMLHTTP")}catch(b){}}function ce(){try{return new a.XMLHttpRequest}catch(b){}}function b$(a,c){a.dataFilter&&(c=a.dataFilter(c,a.dataType));var d=a.dataTypes,e={},g,h,i=d.length,j,k=d[0],l,m,n,o,p;for(g=1;g<i;g++){if(g===1)for(h in a.converters)typeof h=="string"&&(e[h.toLowerCase()]=a.converters[h]);l=k,k=d[g];if(k==="*")k=l;else if(l!=="*"&&l!==k){m=l+" "+k,n=e[m]||e["* "+k];if(!n){p=b;for(o in e){j=o.split(" ");if(j[0]===l||j[0]==="*"){p=e[j[1]+" "+k];if(p){o=e[o],o===!0?n=p:p===!0&&(n=o);break}}}}!n&&!p&&f.error("No conversion from "+m.replace(" "," to ")),n!==!0&&(c=n?n(c):p(o(c)))}}return c}function bZ(a,c,d){var e=a.contents,f=a.dataTypes,g=a.responseFields,h,i,j,k;for(i in g)i in d&&(c[g[i]]=d[i]);while(f[0]==="*")f.shift(),h===b&&(h=a.mimeType||c.getResponseHeader("content-type"));if(h)for(i in e)if(e[i]&&e[i].test(h)){f.unshift(i);break}if(f[0]in d)j=f[0];else{for(i in d){if(!f[0]||a.converters[i+" "+f[0]]){j=i;break}k||(k=i)}j=j||k}if(j){j!==f[0]&&f.unshift(j);return d[j]}}function bY(a,b,c,d){if(f.isArray(b))f.each(b,function(b,e){c||bA.test(a)?d(a,e):bY(a+"["+(typeof e=="object"||f.isArray(e)?b:"")+"]",e,c,d)});else if(!c&&b!=null&&typeof b=="object")for(var e in b)bY(a+"["+e+"]",b[e],c,d);else d(a,b)}function bX(a,c){var d,e,g=f.ajaxSettings.flatOptions||{};for(d in c)c[d]!==b&&((g[d]?a:e||(e={}))[d]=c[d]);e&&f.extend(!0,a,e)}function bW(a,c,d,e,f,g){f=f||c.dataTypes[0],g=g||{},g[f]=!0;var h=a[f],i=0,j=h?h.length:0,k=a===bP,l;for(;i<j&&(k||!l);i++)l=h[i](c,d,e),typeof l=="string"&&(!k||g[l]?l=b:(c.dataTypes.unshift(l),l=bW(a,c,d,e,l,g)));(k||!l)&&!g["*"]&&(l=bW(a,c,d,e,"*",g));return l}function bV(a){return function(b,c){typeof b!="string"&&(c=b,b="*");if(f.isFunction(c)){var d=b.toLowerCase().split(bL),e=0,g=d.length,h,i,j;for(;e<g;e++)h=d[e],j=/^\+/.test(h),j&&(h=h.substr(1)||"*"),i=a[h]=a[h]||[],i[j?"unshift":"push"](c)}}}function by(a,b,c){var d=b==="width"?a.offsetWidth:a.offsetHeight,e=b==="width"?bt:bu;if(d>0){c!=="border"&&f.each(e,function(){c||(d-=parseFloat(f.css(a,"padding"+this))||0),c==="margin"?d+=parseFloat(f.css(a,c+this))||0:d-=parseFloat(f.css(a,"border"+this+"Width"))||0});return d+"px"}d=bv(a,b,b);if(d<0||d==null)d=a.style[b]||0;d=parseFloat(d)||0,c&&f.each(e,function(){d+=parseFloat(f.css(a,"padding"+this))||0,c!=="padding"&&(d+=parseFloat(f.css(a,"border"+this+"Width"))||0),c==="margin"&&(d+=parseFloat(f.css(a,c+this))||0)});return d+"px"}function bl(a,b){b.src?f.ajax({url:b.src,async:!1,dataType:"script"}):f.globalEval((b.text||b.textContent||b.innerHTML||"").replace(bd,"/*$0*/")),b.parentNode&&b.parentNode.removeChild(b)}function bk(a){f.nodeName(a,"input")?bj(a):"getElementsByTagName"in a&&f.grep(a.getElementsByTagName("input"),bj)}function bj(a){if(a.type==="checkbox"||a.type==="radio")a.defaultChecked=a.checked}function bi(a){return"getElementsByTagName"in a?a.getElementsByTagName("*"):"querySelectorAll"in a?a.querySelectorAll("*"):[]}function bh(a,b){var c;if(b.nodeType===1){b.clearAttributes&&b.clearAttributes(),b.mergeAttributes&&b.mergeAttributes(a),c=b.nodeName.toLowerCase();if(c==="object")b.outerHTML=a.outerHTML;else if(c!=="input"||a.type!=="checkbox"&&a.type!=="radio"){if(c==="option")b.selected=a.defaultSelected;else if(c==="input"||c==="textarea")b.defaultValue=a.defaultValue}else a.checked&&(b.defaultChecked=b.checked=a.checked),b.value!==a.value&&(b.value=a.value);b.removeAttribute(f.expando)}}function bg(a,b){if(b.nodeType===1&&!!f.hasData(a)){var c=f.expando,d=f.data(a),e=f.data(b,d);if(d=d[c]){var g=d.events;e=e[c]=f.extend({},d);if(g){delete e.handle,e.events={};for(var h in g)for(var i=0,j=g[h].length;i<j;i++)f.event.add(b,h+(g[h][i].namespace?".":"")+g[h][i].namespace,g[h][i],g[h][i].data)}}}}function bf(a,b){return f.nodeName(a,"table")?a.getElementsByTagName("tbody")[0]||a.appendChild(a.ownerDocument.createElement("tbody")):a}function V(a,b,c){b=b||0;if(f.isFunction(b))return f.grep(a,function(a,d){var e=!!b.call(a,d,a);return e===c});if(b.nodeType)return f.grep(a,function(a,d){return a===b===c});if(typeof b=="string"){var d=f.grep(a,function(a){return a.nodeType===1});if(Q.test(b))return f.filter(b,d,!c);b=f.filter(b,d)}return f.grep(a,function(a,d){return f.inArray(a,b)>=0===c})}function U(a){return!a||!a.parentNode||a.parentNode.nodeType===11}function M(a,b){return(a&&a!=="*"?a+".":"")+b.replace(y,"`").replace(z,"&")}function L(a){var b,c,d,e,g,h,i,j,k,l,m,n,o,p=[],q=[],r=f._data(this,"events");if(!(a.liveFired===this||!r||!r.live||a.target.disabled||a.button&&a.type==="click")){a.namespace&&(n=new RegExp("(^|\\.)"+a.namespace.split(".").join("\\.(?:.*\\.)?")+"(\\.|$)")),a.liveFired=this;var s=r.live.slice(0);for(i=0;i<s.length;i++)g=s[i],g.origType.replace(w,"")===a.type?q.push(g.selector):s.splice(i--,1);e=f(a.target).closest(q,a.currentTarget);for(j=0,k=e.length;j<k;j++){m=e[j];for(i=0;i<s.length;i++){g=s[i];if(m.selector===g.selector&&(!n||n.test(g.namespace))&&!m.elem.disabled){h=m.elem,d=null;if(g.preType==="mouseenter"||g.preType==="mouseleave")a.type=g.preType,d=f(a.relatedTarget).closest(g.selector)[0],d&&f.contains(h,d)&&(d=h);(!d||d!==h)&&p.push({elem:h,handleObj:g,level:m.level})}}}for(j=0,k=p.length;j<k;j++){e=p[j];if(c&&e.level>c)break;a.currentTarget=e.elem,a.data=e.handleObj.data,a.handleObj=e.handleObj,o=e.handleObj.origHandler.apply(e.elem,arguments);if(o===!1||a.isPropagationStopped()){c=e.level,o===!1&&(b=!1);if(a.isImmediatePropagationStopped())break}}return b}}function J(a,c,d){var e=f.extend({},d[0]);e.type=a,e.originalEvent={},e.liveFired=b,f.event.handle.call(c,e),e.isDefaultPrevented()&&d[0].preventDefault()}function D(){return!0}function C(){return!1}function m(a,c,d){var e=c+"defer",g=c+"queue",h=c+"mark",i=f.data(a,e,b,!0);i&&(d==="queue"||!f.data(a,g,b,!0))&&(d==="mark"||!f.data(a,h,b,!0))&&setTimeout(function(){!f.data(a,g,b,!0)&&!f.data(a,h,b,!0)&&(f.removeData(a,e,!0),i.resolve())},0)}function l(a){for(var b in a)if(b!=="toJSON")return!1;return!0}function k(a,c,d){if(d===b&&a.nodeType===1){var e="data-"+c.replace(j,"-$1").toLowerCase();d=a.getAttribute(e);if(typeof d=="string"){try{d=d==="true"?!0:d==="false"?!1:d==="null"?null:f.isNaN(d)?i.test(d)?f.parseJSON(d):d:parseFloat(d)}catch(g){}f.data(a,c,d)}else d=b}return d}var c=a.document,d=a.navigator,e=a.location,f=function(){function K(){if(!e.isReady){try{c.documentElement.doScroll("left")}catch(a){setTimeout(K,1);return}e.ready()}}var e=function(a,b){return new e.fn.init(a,b,h)},f=a.jQuery,g=a.$,h,i=/^(?:[^#<]*(<[\w\W]+>)[^>]*$|#([\w\-]*)$)/,j=/\S/,k=/^\s+/,l=/\s+$/,m=/\d/,n=/^<(\w+)\s*\/?>(?:<\/\1>)?$/,o=/^[\],:{}\s]*$/,p=/\\(?:["\\\/bfnrt]|u[0-9a-fA-F]{4})/g,q=/"[^"\\\n\r]*"|true|false|null|-?\d+(?:\.\d*)?(?:[eE][+\-]?\d+)?/g,r=/(?:^|:|,)(?:\s*\[)+/g,s=/(webkit)[ \/]([\w.]+)/,t=/(opera)(?:.*version)?[ \/]([\w.]+)/,u=/(msie) ([\w.]+)/,v=/(mozilla)(?:.*? rv:([\w.]+))?/,w=/-([a-z]|[0-9])/ig,x=/^-ms-/,y=function(a,b){return(b+"").toUpperCase()},z=d.userAgent,A,B,C,D=Object.prototype.toString,E=Object.prototype.hasOwnProperty,F=Array.prototype.push,G=Array.prototype.slice,H=String.prototype.trim,I=Array.prototype.indexOf,J={};e.fn=e.prototype={constructor:e,init:function(a,d,f){var g,h,j,k;if(!a)return this;if(a.nodeType){this.context=this[0]=a,this.length=1;return this}if(a==="body"&&!d&&c.body){this.context=c,this[0]=c.body,this.selector=a,this.length=1;return this}if(typeof a=="string"){a.charAt(0)!=="<"||a.charAt(a.length-1)!==">"||a.length<3?g=i.exec(a):g=[null,a,null];if(g&&(g[1]||!d)){if(g[1]){d=d instanceof e?d[0]:d,k=d?d.ownerDocument||d:c,j=n.exec(a),j?e.isPlainObject(d)?(a=[c.createElement(j[1])],e.fn.attr.call(a,d,!0)):a=[k.createElement(j[1])]:(j=e.buildFragment([g[1]],[k]),a=(j.cacheable?e.clone(j.fragment):j.fragment).childNodes);return e.merge(this,a)}h=c.getElementById(g[2]);if(h&&h.parentNode){if(h.id!==g[2])return f.find(a);this.length=1,this[0]=h}this.context=c,this.selector=a;return this}return!d||d.jquery?(d||f).find(a):this.constructor(d).find(a)}if(e.isFunction(a))return f.ready(a);a.selector!==b&&(this.selector=a.selector,this.context=a.context);return e.makeArray(a,this)},selector:"",jquery:"1.6.4",length:0,size:function(){return this.length},toArray:function(){return G.call(this,0)},get:function(a){return a==null?this.toArray():a<0?this[this.length+a]:this[a]},pushStack:function(a,b,c){var d=this.constructor();e.isArray(a)?F.apply(d,a):e.merge(d,a),d.prevObject=this,d.context=this.context,b==="find"?d.selector=this.selector+(this.selector?" ":"")+c:b&&(d.selector=this.selector+"."+b+"("+c+")");return d},each:function(a,b){return e.each(this,a,b)},ready:function(a){e.bindReady(),B.done(a);return this},eq:function(a){return a===-1?this.slice(a):this.slice(a,+a+1)},first:function(){return this.eq(0)},last:function(){return this.eq(-1)},slice:function(){return this.pushStack(G.apply(this,arguments),"slice",G.call(arguments).join(","))},map:function(a){return this.pushStack(e.map(this,function(b,c){return a.call(b,c,b)}))},end:function(){return this.prevObject||this.constructor(null)},push:F,sort:[].sort,splice:[].splice},e.fn.init.prototype=e.fn,e.extend=e.fn.extend=function(){var a,c,d,f,g,h,i=arguments[0]||{},j=1,k=arguments.length,l=!1;typeof i=="boolean"&&(l=i,i=arguments[1]||{},j=2),typeof i!="object"&&!e.isFunction(i)&&(i={}),k===j&&(i=this,--j);for(;j<k;j++)if((a=arguments[j])!=null)for(c in a){d=i[c],f=a[c];if(i===f)continue;l&&f&&(e.isPlainObject(f)||(g=e.isArray(f)))?(g?(g=!1,h=d&&e.isArray(d)?d:[]):h=d&&e.isPlainObject(d)?d:{},i[c]=e.extend(l,h,f)):f!==b&&(i[c]=f)}return i},e.extend({noConflict:function(b){a.$===e&&(a.$=g),b&&a.jQuery===e&&(a.jQuery=f);return e},isReady:!1,readyWait:1,holdReady:function(a){a?e.readyWait++:e.ready(!0)},ready:function(a){if(a===!0&&!--e.readyWait||a!==!0&&!e.isReady){if(!c.body)return setTimeout(e.ready,1);e.isReady=!0;if(a!==!0&&--e.readyWait>0)return;B.resolveWith(c,[e]),e.fn.trigger&&e(c).trigger("ready").unbind("ready")}},bindReady:function(){if(!B){B=e._Deferred();if(c.readyState==="complete")return setTimeout(e.ready,1);if(c.addEventListener)c.addEventListener("DOMContentLoaded",C,!1),a.addEventListener("load",e.ready,!1);else if(c.attachEvent){c.attachEvent("onreadystatechange",C),a.attachEvent("onload",e.ready);var b=!1;try{b=a.frameElement==null}catch(d){}c.documentElement.doScroll&&b&&K()}}},isFunction:function(a){return e.type(a)==="function"},isArray:Array.isArray||function(a){return e.type(a)==="array"},isWindow:function(a){return a&&typeof a=="object"&&"setInterval"in a},isNaN:function(a){return a==null||!m.test(a)||isNaN(a)},type:function(a){return a==null?String(a):J[D.call(a)]||"object"},isPlainObject:function(a){if(!a||e.type(a)!=="object"||a.nodeType||e.isWindow(a))return!1;try{if(a.constructor&&!E.call(a,"constructor")&&!E.call(a.constructor.prototype,"isPrototypeOf"))return!1}catch(c){return!1}var d;for(d in a);return d===b||E.call(a,d)},isEmptyObject:function(a){for(var b in a)return!1;return!0},error:function(a){throw a},parseJSON:function(b){if(typeof b!="string"||!b)return null;b=e.trim(b);if(a.JSON&&a.JSON.parse)return a.JSON.parse(b);if(o.test(b.replace(p,"@").replace(q,"]").replace(r,"")))return(new Function("return "+b))();e.error("Invalid JSON: "+b)},parseXML:function(c){var d,f;try{a.DOMParser?(f=new DOMParser,d=f.parseFromString(c,"text/xml")):(d=new ActiveXObject("Microsoft.XMLDOM"),d.async="false",d.loadXML(c))}catch(g){d=b}(!d||!d.documentElement||d.getElementsByTagName("parsererror").length)&&e.error("Invalid XML: "+c);return d},noop:function(){},globalEval:function(b){b&&j.test(b)&&(a.execScript||function(b){a.eval.call(a,b)})(b)},camelCase:function(a){return a.replace(x,"ms-").replace(w,y)},nodeName:function(a,b){return a.nodeName&&a.nodeName.toUpperCase()===b.toUpperCase()},each:function(a,c,d){var f,g=0,h=a.length,i=h===b||e.isFunction(a);if(d){if(i){for(f in a)if(c.apply(a[f],d)===!1)break}else for(;g<h;)if(c.apply(a[g++],d)===!1)break}else if(i){for(f in a)if(c.call(a[f],f,a[f])===!1)break}else for(;g<h;)if(c.call(a[g],g,a[g++])===!1)break;return a},trim:H?function(a){return a==null?"":H.call(a)}:function(a){return a==null?"":(a+"").replace(k,"").replace(l,"")},makeArray:function(a,b){var c=b||[];if(a!=null){var d=e.type(a);a.length==null||d==="string"||d==="function"||d==="regexp"||e.isWindow(a)?F.call(c,a):e.merge(c,a)}return c},inArray:function(a,b){if(!b)return-1;if(I)return I.call(b,a);for(var c=0,d=b.length;c<d;c++)if(b[c]===a)return c;return-1},merge:function(a,c){var d=a.length,e=0;if(typeof c.length=="number")for(var f=c.length;e<f;e++)a[d++]=c[e];else while(c[e]!==b)a[d++]=c[e++];a.length=d;return a},grep:function(a,b,c){var d=[],e;c=!!c;for(var f=0,g=a.length;f<g;f++)e=!!b(a[f],f),c!==e&&d.push(a[f]);return d},map:function(a,c,d){var f,g,h=[],i=0,j=a.length,k=a instanceof e||j!==b&&typeof j=="number"&&(j>0&&a[0]&&a[j-1]||j===0||e.isArray(a));if(k)for(;i<j;i++)f=c(a[i],i,d),f!=null&&(h[h.length]=f);else for(g in a)f=c(a[g],g,d),f!=null&&(h[h.length]=f);return h.concat.apply([],h)},guid:1,proxy:function(a,c){if(typeof c=="string"){var d=a[c];c=a,a=d}if(!e.isFunction(a))return b;var f=G.call(arguments,2),g=function(){return a.apply(c,f.concat(G.call(arguments)))};g.guid=a.guid=a.guid||g.guid||e.guid++;return g},access:function(a,c,d,f,g,h){var i=a.length;if(typeof c=="object"){for(var j in c)e.access(a,j,c[j],f,g,d);return a}if(d!==b){f=!h&&f&&e.isFunction(d);for(var k=0;k<i;k++)g(a[k],c,f?d.call(a[k],k,g(a[k],c)):d,h);return a}return i?g(a[0],c):b},now:function(){return(new Date).getTime()},uaMatch:function(a){a=a.toLowerCase();var b=s.exec(a)||t.exec(a)||u.exec(a)||a.indexOf("compatible")<0&&v.exec(a)||[];return{browser:b[1]||"",version:b[2]||"0"}},sub:function(){function a(b,c){return new a.fn.init(b,c)}e.extend(!0,a,this),a.superclass=this,a.fn=a.prototype=this(),a.fn.constructor=a,a.sub=this.sub,a.fn.init=function(d,f){f&&f instanceof e&&!(f instanceof a)&&(f=a(f));return e.fn.init.call(this,d,f,b)},a.fn.init.prototype=a.fn;var b=a(c);return a},browser:{}}),e.each("Boolean Number String Function Array Date RegExp Object".split(" "),function(a,b){J["[object "+b+"]"]=b.toLowerCase()}),A=e.uaMatch(z),A.browser&&(e.browser[A.browser]=!0,e.browser.version=A.version),e.browser.webkit&&(e.browser.safari=!0),j.test(" ")&&(k=/^[\s\xA0]+/,l=/[\s\xA0]+$/),h=e(c),c.addEventListener?C=function(){c.removeEventListener("DOMContentLoaded",C,!1),e.ready()}:c.attachEvent&&(C=function(){c.readyState==="complete"&&(c.detachEvent("onreadystatechange",C),e.ready())});return e}(),g="done fail isResolved isRejected promise then always pipe".split(" "),h=[].slice;f.extend({_Deferred:function(){var a=[],b,c,d,e={done:function(){if(!d){var c=arguments,g,h,i,j,k;b&&(k=b,b=0);for(g=0,h=c.length;g<h;g++)i=c[g],j=f.type(i),j==="array"?e.done.apply(e,i):j==="function"&&a.push(i);k&&e.resolveWith(k[0],k[1])}return this},resolveWith:function(e,f){if(!d&&!b&&!c){f=f||[],c=1;try{while(a[0])a.shift().apply(e,f)}finally{b=[e,f],c=0}}return this},resolve:function(){e.resolveWith(this,arguments);return this},isResolved:function(){return!!c||!!b},cancel:function(){d=1,a=[];return this}};return e},Deferred:function(a){var b=f._Deferred(),c=f._Deferred(),d;f.extend(b,{then:function(a,c){b.done(a).fail(c);return this},always:function(){return b.done.apply(b,arguments).fail.apply(this,arguments)},fail:c.done,rejectWith:c.resolveWith,reject:c.resolve,isRejected:c.isResolved,pipe:function(a,c){return f.Deferred(function(d){f.each({done:[a,"resolve"],fail:[c,"reject"]},function(a,c){var e=c[0],g=c[1],h;f.isFunction(e)?b[a](function(){h=e.apply(this,arguments),h&&f.isFunction(h.promise)?h.promise().then(d.resolve,d.reject):d[g+"With"](this===b?d:this,[h])}):b[a](d[g])})}).promise()},promise:function(a){if(a==null){if(d)return d;d=a={}}var c=g.length;while(c--)a[g[c]]=b[g[c]];return a}}),b.done(c.cancel).fail(b.cancel),delete b.cancel,a&&a.call(b,b);return b},when:function(a){function i(a){return function(c){b[a]=arguments.length>1?h.call(arguments,0):c,--e||g.resolveWith(g,h.call(b,0))}}var b=arguments,c=0,d=b.length,e=d,g=d<=1&&a&&f.isFunction(a.promise)?a:f.Deferred();if(d>1){for(;c<d;c++)b[c]&&f.isFunction(b[c].promise)?b[c].promise().then(i(c),g.reject):--e;e||g.resolveWith(g,b)}else g!==a&&g.resolveWith(g,d?[a]:[]);return g.promise()}}),f.support=function(){var a=c.createElement("div"),b=c.documentElement,d,e,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u;a.setAttribute("className","t"),a.innerHTML="   <link/><table></table><a href='/a' style='top:1px;float:left;opacity:.55;'>a</a><input type='checkbox'/>",d=a.getElementsByTagName("*"),e=a.getElementsByTagName("a")[0];if(!d||!d.length||!e)return{};g=c.createElement("select"),h=g.appendChild(c.createElement("option")),i=a.getElementsByTagName("input")[0],k={leadingWhitespace:a.firstChild.nodeType===3,tbody:!a.getElementsByTagName("tbody").length,htmlSerialize:!!a.getElementsByTagName("link").length,style:/top/.test(e.getAttribute("style")),hrefNormalized:e.getAttribute("href")==="/a",opacity:/^0.55$/.test(e.style.opacity),cssFloat:!!e.style.cssFloat,checkOn:i.value==="on",optSelected:h.selected,getSetAttribute:a.className!=="t",submitBubbles:!0,changeBubbles:!0,focusinBubbles:!1,deleteExpando:!0,noCloneEvent:!0,inlineBlockNeedsLayout:!1,shrinkWrapBlocks:!1,reliableMarginRight:!0},i.checked=!0,k.noCloneChecked=i.cloneNode(!0).checked,g.disabled=!0,k.optDisabled=!h.disabled;try{delete a.test}catch(v){k.deleteExpando=!1}!a.addEventListener&&a.attachEvent&&a.fireEvent&&(a.attachEvent("onclick",function(){k.noCloneEvent=!1}),a.cloneNode(!0).fireEvent("onclick")),i=c.createElement("input"),i.value="t",i.setAttribute("type","radio"),k.radioValue=i.value==="t",i.setAttribute("checked","checked"),a.appendChild(i),l=c.createDocumentFragment(),l.appendChild(a.firstChild),k.checkClone=l.cloneNode(!0).cloneNode(!0).lastChild.checked,a.innerHTML="",a.style.width=a.style.paddingLeft="1px",m=c.getElementsByTagName("body")[0],o=c.createElement(m?"div":"body"),p={visibility:"hidden",width:0,height:0,border:0,margin:0,background:"none"},m&&f.extend(p,{position:"absolute",left:"-1000px",top:"-1000px"});for(t in p)o.style[t]=p[t];o.appendChild(a),n=m||b,n.insertBefore(o,n.firstChild),k.appendChecked=i.checked,k.boxModel=a.offsetWidth===2,"zoom"in a.style&&(a.style.display="inline",a.style.zoom=1,k.inlineBlockNeedsLayout=a.offsetWidth===2,a.style.display="",a.innerHTML="<div style='width:4px;'></div>",k.shrinkWrapBlocks=a.offsetWidth!==2),a.innerHTML="<table><tr><td style='padding:0;border:0;display:none'></td><td>t</td></tr></table>",q=a.getElementsByTagName("td"),u=q[0].offsetHeight===0,q[0].style.display="",q[1].style.display="none",k.reliableHiddenOffsets=u&&q[0].offsetHeight===0,a.innerHTML="",c.defaultView&&c.defaultView.getComputedStyle&&(j=c.createElement("div"),j.style.width="0",j.style.marginRight="0",a.appendChild(j),k.reliableMarginRight=(parseInt((c.defaultView.getComputedStyle(j,null)||{marginRight:0}).marginRight,10)||0)===0),o.innerHTML="",n.removeChild(o);if(a.attachEvent)for(t in{submit:1,change:1,focusin:1})s="on"+t,u=s in a,u||(a.setAttribute(s,"return;"),u=typeof a[s]=="function"),k[t+"Bubbles"]=u;o=l=g=h=m=j=a=i=null;return k}(),f.boxModel=f.support.boxModel;var i=/^(?:\{.*\}|\[.*\])$/,j=/([A-Z])/g;f.extend({cache:{},uuid:0,expando:"jQuery"+(f.fn.jquery+Math.random()).replace(/\D/g,""),noData:{embed:!0,object:"clsid:D27CDB6E-AE6D-11cf-96B8-444553540000",applet:!0},hasData:function(a){a=a.nodeType?f.cache[a[f.expando]]:a[f.expando];return!!a&&!l(a)},data:function(a,c,d,e){if(!!f.acceptData(a)){var g,h,i=f.expando,j=typeof c=="string",k=a.nodeType,l=k?f.cache:a,m=k?a[f.expando]:a[f.expando]&&f.expando;if((!m||e&&m&&l[m]&&!l[m][i])&&j&&d===b)return;m||(k?a[f.expando]=m=++f.uuid:m=f.expando),l[m]||(l[m]={},k||(l[m].toJSON=f.noop));if(typeof c=="object"||typeof c=="function")e?l[m][i]=f.extend(l[m][i],c):l[m]=f.extend(l[m],c);g=l[m],e&&(g[i]||(g[i]={}),g=g[i]),d!==b&&(g[f.camelCase(c)]=d);if(c==="events"&&!g[c])return g[i]&&g[i].events;j?(h=g[c],h==null&&(h=g[f.camelCase(c)])):h=g;return h}},removeData:function(a,b,c){if(!!f.acceptData(a)){var d,e=f.expando,g=a.nodeType,h=g?f.cache:a,i=g?a[f.expando]:f.expando;if(!h[i])return;if(b){d=c?h[i][e]:h[i];if(d){d[b]||(b=f.camelCase(b)),delete d[b];if(!l(d))return}}if(c){delete h[i][e];if(!l(h[i]))return}var j=h[i][e];f.support.deleteExpando||!h.setInterval?delete h[i]:h[i]=null,j?(h[i]={},g||(h[i].toJSON=f.noop),h[i][e]=j):g&&(f.support.deleteExpando?delete a[f.expando]:a.removeAttribute?a.removeAttribute(f.expando):a[f.expando]=null)}},_data:function(a,b,c){return f.data(a,b,c,!0)},acceptData:function(a){if(a.nodeName){var b=f.noData[a.nodeName.toLowerCase()];if(b)return b!==!0&&a.getAttribute("classid")===b}return!0}}),f.fn.extend({data:function(a,c){var d=null;if(typeof a=="undefined"){if(this.length){d=f.data(this[0]);if(this[0].nodeType===1){var e=this[0].attributes,g;for(var h=0,i=e.length;h<i;h++)g=e[h].name,g.indexOf("data-")===0&&(g=f.camelCase(g.substring(5)),k(this[0],g,d[g]))}}return d}if(typeof a=="object")return this.each(function(){f.data(this,a)});var j=a.split(".");j[1]=j[1]?"."+j[1]:"";if(c===b){d=this.triggerHandler("getData"+j[1]+"!",[j[0]]),d===b&&this.length&&(d=f.data(this[0],a),d=k(this[0],a,d));return d===b&&j[1]?this.data(j[0]):d}return this.each(function(){var b=f(this),d=[j[0],c];b.triggerHandler("setData"+j[1]+"!",d),f.data(this,a,c),b.triggerHandler("changeData"+j[1]+"!",d)})},removeData:function(a){return this.each(function(){f.removeData(this,a)})}}),f.extend({_mark:function(a,c){a&&(c=(c||"fx")+"mark",f.data(a,c,(f.data(a,c,b,!0)||0)+1,!0))},_unmark:function(a,c,d){a!==!0&&(d=c,c=a,a=!1);if(c){d=d||"fx";var e=d+"mark",g=a?0:(f.data(c,e,b,!0)||1)-1;g?f.data(c,e,g,!0):(f.removeData(c,e,!0),m(c,d,"mark"))}},queue:function(a,c,d){if(a){c=(c||"fx")+"queue";var e=f.data(a,c,b,!0);d&&(!e||f.isArray(d)?e=f.data(a,c,f.makeArray(d),!0):e.push(d));return e||[]}},dequeue:function(a,b){b=b||"fx";var c=f.queue(a,b),d=c.shift(),e;d==="inprogress"&&(d=c.shift()),d&&(b==="fx"&&c.unshift("inprogress"),d.call(a,function(){f.dequeue(a,b)})),c.length||(f.removeData(a,b+"queue",!0),m(a,b,"queue"))}}),f.fn.extend({queue:function(a,c){typeof a!="string"&&(c=a,a="fx");if(c===b)return f.queue(this[0],a);return this.each(function(){var b=f.queue(this,a,c);a==="fx"&&b[0]!=="inprogress"&&f.dequeue(this,a)})},dequeue:function(a){return this.each(function(){f.dequeue(this,a)})},delay:function(a,b){a=f.fx?f.fx.speeds[a]||a:a,b=b||"fx";return this.queue(b,function(){var c=this;setTimeout(function(){f.dequeue(c,b)},a)})},clearQueue:function(a){return this.queue(a||"fx",[])},promise:function(a,c){function m(){--h||d.resolveWith(e,[e])}typeof a!="string"&&(c=a,a=b),a=a||"fx";var d=f.Deferred(),e=this,g=e.length,h=1,i=a+"defer",j=a+"queue",k=a+"mark",l;while(g--)if(l=f.data(e[g],i,b,!0)||(f.data(e[g],j,b,!0)||f.data(e[g],k,b,!0))&&f.data(e[g],i,f._Deferred(),!0))h++,l.done(m);m();return d.promise()}});var n=/[\n\t\r]/g,o=/\s+/,p=/\r/g,q=/^(?:button|input)$/i,r=/^(?:button|input|object|select|textarea)$/i,s=/^a(?:rea)?$/i,t=/^(?:autofocus|autoplay|async|checked|controls|defer|disabled|hidden|loop|multiple|open|readonly|required|scoped|selected)$/i,u,v;f.fn.extend({attr:function(a,b){return f.access(this,a,b,!0,f.attr)},removeAttr:function(a){return this.each(function(){f.removeAttr(this,a)})},prop:function(a,b){return f.access(this,a,b,!0,f.prop)},removeProp:function(a){a=f.propFix[a]||a;return this.each(function(){try{this[a]=b,delete this[a]}catch(c){}})},addClass:function(a){var b,c,d,e,g,h,i;if(f.isFunction(a))return this.each(function(b){f(this).addClass(a.call(this,b,this.className))});if(a&&typeof a=="string"){b=a.split(o);for(c=0,d=this.length;c<d;c++){e=this[c];if(e.nodeType===1)if(!e.className&&b.length===1)e.className=a;else{g=" "+e.className+" ";for(h=0,i=b.length;h<i;h++)~g.indexOf(" "+b[h]+" ")||(g+=b[h]+" ");e.className=f.trim(g)}}}return this},removeClass:function(a){var c,d,e,g,h,i,j;if(f.isFunction(a))return this.each(function(b){f(this).removeClass(a.call(this,b,this.className))});if(a&&typeof a=="string"||a===b){c=(a||"").split(o);for(d=0,e=this.length;d<e;d++){g=this[d];if(g.nodeType===1&&g.className)if(a){h=(" "+g.className+" ").replace(n," ");for(i=0,j=c.length;i<j;i++)h=h.replace(" "+c[i]+" "," ");g.className=f.trim(h)}else g.className=""}}return this},toggleClass:function(a,b){var c=typeof a,d=typeof b=="boolean";if(f.isFunction(a))return this.each(function(c){f(this).toggleClass(a.call(this,c,this.className,b),b)});return this.each(function(){if(c==="string"){var e,g=0,h=f(this),i=b,j=a.split(o);while(e=j[g++])i=d?i:!h.hasClass(e),h[i?"addClass":"removeClass"](e)}else if(c==="undefined"||c==="boolean")this.className&&f._data(this,"__className__",this.className),this.className=this.className||a===!1?"":f._data(this,"__className__")||""})},hasClass:function(a){var b=" "+a+" ";for(var c=0,d=this.length;c<d;c++)if(this[c].nodeType===1&&(" "+this[c].className+" ").replace(n," ").indexOf(b)>-1)return!0;return!1},val:function(a){var c,d,e=this[0];if(!arguments.length){if(e){c=f.valHooks[e.nodeName.toLowerCase()]||f.valHooks[e.type];if(c&&"get"in c&&(d=c.get(e,"value"))!==b)return d;d=e.value;return typeof d=="string"?d.replace(p,""):d==null?"":d}return b}var g=f.isFunction(a);return this.each(function(d){var e=f(this),h;if(this.nodeType===1){g?h=a.call(this,d,e.val()):h=a,h==null?h="":typeof h=="number"?h+="":f.isArray(h)&&(h=f.map(h,function(a){return a==null?"":a+""})),c=f.valHooks[this.nodeName.toLowerCase()]||f.valHooks[this.type];if(!c||!("set"in c)||c.set(this,h,"value")===b)this.value=h}})}}),f.extend({valHooks:{option:{get:function(a){var b=a.attributes.value;return!b||b.specified?a.value:a.text}},select:{get:function(a){var b,c=a.selectedIndex,d=[],e=a.options,g=a.type==="select-one";if(c<0)return null;for(var h=g?c:0,i=g?c+1:e.length;h<i;h++){var j=e[h];if(j.selected&&(f.support.optDisabled?!j.disabled:j.getAttribute("disabled")===null)&&(!j.parentNode.disabled||!f.nodeName(j.parentNode,"optgroup"))){b=f(j).val();if(g)return b;d.push(b)}}if(g&&!d.length&&e.length)return f(e[c]).val();return d},set:function(a,b){var c=f.makeArray(b);f(a).find("option").each(function(){this.selected=f.inArray(f(this).val(),c)>=0}),c.length||(a.selectedIndex=-1);return c}}},attrFn:{val:!0,css:!0,html:!0,text:!0,data:!0,width:!0,height:!0,offset:!0},attrFix:{tabindex:"tabIndex"},attr:function(a,c,d,e){var g=a.nodeType;if(!a||g===3||g===8||g===2)return b;if(e&&c in f.attrFn)return f(a)[c](d);if(!("getAttribute"in a))return f.prop(a,c,d);var h,i,j=g!==1||!f.isXMLDoc(a);j&&(c=f.attrFix[c]||c,i=f.attrHooks[c],i||(t.test(c)?i=v:u&&(i=u)));if(d!==b){if(d===null){f.removeAttr(a,c);return b}if(i&&"set"in i&&j&&(h=i.set(a,d,c))!==b)return h;a.setAttribute(c,""+d);return d}if(i&&"get"in i&&j&&(h=i.get(a,c))!==null)return h;h=a.getAttribute(c);return h===null?b:h},removeAttr:function(a,b){var c;a.nodeType===1&&(b=f.attrFix[b]||b,f.attr(a,b,""),a.removeAttribute(b),t.test(b)&&(c=f.propFix[b]||b)in a&&(a[c]=!1))},attrHooks:{type:{set:function(a,b){if(q.test(a.nodeName)&&a.parentNode)f.error("type property can't be changed");else if(!f.support.radioValue&&b==="radio"&&f.nodeName(a,"input")){var c=a.value;a.setAttribute("type",b),c&&(a.value=c);return b}}},value:{get:function(a,b){if(u&&f.nodeName(a,"button"))return u.get(a,b);return b in a?a.value:null},set:function(a,b,c){if(u&&f.nodeName(a,"button"))return u.set(a,b,c);a.value=b}}},propFix:{tabindex:"tabIndex",readonly:"readOnly","for":"htmlFor","class":"className",maxlength:"maxLength",cellspacing:"cellSpacing",cellpadding:"cellPadding",rowspan:"rowSpan",colspan:"colSpan",usemap:"useMap",frameborder:"frameBorder",contenteditable:"contentEditable"},prop:function(a,c,d){var e=a.nodeType;if(!a||e===3||e===8||e===2)return b;var g,h,i=e!==1||!f.isXMLDoc(a);i&&(c=f.propFix[c]||c,h=f.propHooks[c]);return d!==b?h&&"set"in h&&(g=h.set(a,d,c))!==b?g:a[c]=d:h&&"get"in h&&(g=h.get(a,c))!==null?g:a[c]},propHooks:{tabIndex:{get:function(a){var c=a.getAttributeNode("tabindex");return c&&c.specified?parseInt(c.value,10):r.test(a.nodeName)||s.test(a.nodeName)&&a.href?0:b}}}}),f.attrHooks.tabIndex=f.propHooks.tabIndex,v={get:function(a,c){var d;return f.prop(a,c)===!0||(d=a.getAttributeNode(c))&&d.nodeValue!==!1?c.toLowerCase():b},set:function(a,b,c){var d;b===!1?f.removeAttr(a,c):(d=f.propFix[c]||c,d in a&&(a[d]=!0),a.setAttribute(c,c.toLowerCase()));return c}},f.support.getSetAttribute||(u=f.valHooks.button={get:function(a,c){var d;d=a.getAttributeNode(c);return d&&d.nodeValue!==""?d.nodeValue:b},set:function(a,b,d){var e=a.getAttributeNode(d);e||(e=c.createAttribute(d),a.setAttributeNode(e));return e.nodeValue=b+""}},f.each(["width","height"],function(a,b){f.attrHooks[b]=f.extend(f.attrHooks[b],{set:function(a,c){if(c===""){a.setAttribute(b,"auto");return c}}})})),f.support.hrefNormalized||f.each(["href","src","width","height"],function(a,c){f.attrHooks[c]=f.extend(f.attrHooks[c],{get:function(a){var d=a.getAttribute(c,2);return d===null?b:d}})}),f.support.style||(f.attrHooks.style={get:function(a){return a.style.cssText.toLowerCase()||b},set:function(a,b){return a.style.cssText=""+b}}),f.support.optSelected||(f.propHooks.selected=f.extend(f.propHooks.selected,{get:function(a){var b=a.parentNode;b&&(b.selectedIndex,b.parentNode&&b.parentNode.selectedIndex);return null}})),f.support.checkOn||f.each(["radio","checkbox"],function(){f.valHooks[this]={get:function(a){return a.getAttribute("value")===null?"on":a.value}}}),f.each(["radio","checkbox"],function(){f.valHooks[this]=f.extend(f.valHooks[this],{set:function(a,b){if(f.isArray(b))return a.checked=f.inArray(f(a).val(),b)>=0}})});var w=/\.(.*)$/,x=/^(?:textarea|input|select)$/i,y=/\./g,z=/ /g,A=/[^\w\s.|`]/g,B=function(a){return a.replace(A,"\\$&")};f.event={add:function(a,c,d,e){if(a.nodeType!==3&&a.nodeType!==8){if(d===!1)d=C;else if(!d)return;var g,h;d.handler&&(g=d,d=g.handler),d.guid||(d.guid=f.guid++);var i=f._data(a);if(!i)return;var j=i.events,k=i.handle;j||(i.events=j={}),k||(i.handle=k=function(a){return typeof f!="undefined"&&(!a||f.event.triggered!==a.type)?f.event.handle.apply(k.elem,arguments):b}),k.elem=a,c=c.split(" ");var l,m=0,n;while(l=c[m++]){h=g?f.extend({},g):{handler:d,data:e},l.indexOf(".")>-1?(n=l.split("."),l=n.shift(),h.namespace=n.slice(0).sort().join(".")):(n=[],h.namespace=""),h.type=l,h.guid||(h.guid=d.guid);var o=j[l],p=f.event.special[l]||{};if(!o){o=j[l]=[];if(!p.setup||p.setup.call(a,e,n,k)===!1)a.addEventListener?a.addEventListener(l,k,!1):a.attachEvent&&a.attachEvent("on"+l,k)}p.add&&(p.add.call(a,h),h.handler.guid||(h.handler.guid=d.guid)),o.push(h),f.event.global[l]=!0}a=null}},global:{},remove:function(a,c,d,e){if(a.nodeType!==3&&a.nodeType!==8){d===!1&&(d=C);var g,h,i,j,k=0,l,m,n,o,p,q,r,s=f.hasData(a)&&f._data(a),t=s&&s.events;if(!s||!t)return;c&&c.type&&(d=c.handler,c=c.type);if(!c||typeof c=="string"&&c.charAt(0)==="."){c=c||"";for(h in t)f.event.remove(a,h+c);return}c=c.split(" ");while(h=c[k++]){r=h,q=null,l=h.indexOf(".")<0,m=[],l||(m=h.split("."),h=m.shift(),n=new RegExp("(^|\\.)"+f.map(m.slice(0).sort(),B).join("\\.(?:.*\\.)?")+"(\\.|$)")),p=t[h];if(!p)continue;if(!d){for(j=0;j<p.length;j++){q=p[j];if(l||n.test(q.namespace))f.event.remove(a,r,q.handler,j),p.splice(j--,1)}continue}o=f.event.special[h]||{};for(j=e||0;j<p.length;j++){q=p[j];if(d.guid===q.guid){if(l||n.test(q.namespace))e==null&&p.splice(j--,1),o.remove&&o.remove.call(a,q);if(e!=null)break}}if(p.length===0||e!=null&&p.length===1)(!o.teardown||o.teardown.call(a,m)===!1)&&f.removeEvent(a,h,s.handle),g=null,delete -t[h]}if(f.isEmptyObject(t)){var u=s.handle;u&&(u.elem=null),delete s.events,delete s.handle,f.isEmptyObject(s)&&f.removeData(a,b,!0)}}},customEvent:{getData:!0,setData:!0,changeData:!0},trigger:function(c,d,e,g){var h=c.type||c,i=[],j;h.indexOf("!")>=0&&(h=h.slice(0,-1),j=!0),h.indexOf(".")>=0&&(i=h.split("."),h=i.shift(),i.sort());if(!!e&&!f.event.customEvent[h]||!!f.event.global[h]){c=typeof c=="object"?c[f.expando]?c:new f.Event(h,c):new f.Event(h),c.type=h,c.exclusive=j,c.namespace=i.join("."),c.namespace_re=new RegExp("(^|\\.)"+i.join("\\.(?:.*\\.)?")+"(\\.|$)");if(g||!e)c.preventDefault(),c.stopPropagation();if(!e){f.each(f.cache,function(){var a=f.expando,b=this[a];b&&b.events&&b.events[h]&&f.event.trigger(c,d,b.handle.elem)});return}if(e.nodeType===3||e.nodeType===8)return;c.result=b,c.target=e,d=d!=null?f.makeArray(d):[],d.unshift(c);var k=e,l=h.indexOf(":")<0?"on"+h:"";do{var m=f._data(k,"handle");c.currentTarget=k,m&&m.apply(k,d),l&&f.acceptData(k)&&k[l]&&k[l].apply(k,d)===!1&&(c.result=!1,c.preventDefault()),k=k.parentNode||k.ownerDocument||k===c.target.ownerDocument&&a}while(k&&!c.isPropagationStopped());if(!c.isDefaultPrevented()){var n,o=f.event.special[h]||{};if((!o._default||o._default.call(e.ownerDocument,c)===!1)&&(h!=="click"||!f.nodeName(e,"a"))&&f.acceptData(e)){try{l&&e[h]&&(n=e[l],n&&(e[l]=null),f.event.triggered=h,e[h]())}catch(p){}n&&(e[l]=n),f.event.triggered=b}}return c.result}},handle:function(c){c=f.event.fix(c||a.event);var d=((f._data(this,"events")||{})[c.type]||[]).slice(0),e=!c.exclusive&&!c.namespace,g=Array.prototype.slice.call(arguments,0);g[0]=c,c.currentTarget=this;for(var h=0,i=d.length;h<i;h++){var j=d[h];if(e||c.namespace_re.test(j.namespace)){c.handler=j.handler,c.data=j.data,c.handleObj=j;var k=j.handler.apply(this,g);k!==b&&(c.result=k,k===!1&&(c.preventDefault(),c.stopPropagation()));if(c.isImmediatePropagationStopped())break}}return c.result},props:"altKey attrChange attrName bubbles button cancelable charCode clientX clientY ctrlKey currentTarget data detail eventPhase fromElement handler keyCode layerX layerY metaKey newValue offsetX offsetY pageX pageY prevValue relatedNode relatedTarget screenX screenY shiftKey srcElement target toElement view wheelDelta which".split(" "),fix:function(a){if(a[f.expando])return a;var d=a;a=f.Event(d);for(var e=this.props.length,g;e;)g=this.props[--e],a[g]=d[g];a.target||(a.target=a.srcElement||c),a.target.nodeType===3&&(a.target=a.target.parentNode),!a.relatedTarget&&a.fromElement&&(a.relatedTarget=a.fromElement===a.target?a.toElement:a.fromElement);if(a.pageX==null&&a.clientX!=null){var h=a.target.ownerDocument||c,i=h.documentElement,j=h.body;a.pageX=a.clientX+(i&&i.scrollLeft||j&&j.scrollLeft||0)-(i&&i.clientLeft||j&&j.clientLeft||0),a.pageY=a.clientY+(i&&i.scrollTop||j&&j.scrollTop||0)-(i&&i.clientTop||j&&j.clientTop||0)}a.which==null&&(a.charCode!=null||a.keyCode!=null)&&(a.which=a.charCode!=null?a.charCode:a.keyCode),!a.metaKey&&a.ctrlKey&&(a.metaKey=a.ctrlKey),!a.which&&a.button!==b&&(a.which=a.button&1?1:a.button&2?3:a.button&4?2:0);return a},guid:1e8,proxy:f.proxy,special:{ready:{setup:f.bindReady,teardown:f.noop},live:{add:function(a){f.event.add(this,M(a.origType,a.selector),f.extend({},a,{handler:L,guid:a.handler.guid}))},remove:function(a){f.event.remove(this,M(a.origType,a.selector),a)}},beforeunload:{setup:function(a,b,c){f.isWindow(this)&&(this.onbeforeunload=c)},teardown:function(a,b){this.onbeforeunload===b&&(this.onbeforeunload=null)}}}},f.removeEvent=c.removeEventListener?function(a,b,c){a.removeEventListener&&a.removeEventListener(b,c,!1)}:function(a,b,c){a.detachEvent&&a.detachEvent("on"+b,c)},f.Event=function(a,b){if(!this.preventDefault)return new f.Event(a,b);a&&a.type?(this.originalEvent=a,this.type=a.type,this.isDefaultPrevented=a.defaultPrevented||a.returnValue===!1||a.getPreventDefault&&a.getPreventDefault()?D:C):this.type=a,b&&f.extend(this,b),this.timeStamp=f.now(),this[f.expando]=!0},f.Event.prototype={preventDefault:function(){this.isDefaultPrevented=D;var a=this.originalEvent;!a||(a.preventDefault?a.preventDefault():a.returnValue=!1)},stopPropagation:function(){this.isPropagationStopped=D;var a=this.originalEvent;!a||(a.stopPropagation&&a.stopPropagation(),a.cancelBubble=!0)},stopImmediatePropagation:function(){this.isImmediatePropagationStopped=D,this.stopPropagation()},isDefaultPrevented:C,isPropagationStopped:C,isImmediatePropagationStopped:C};var E=function(a){var b=a.relatedTarget,c=!1,d=a.type;a.type=a.data,b!==this&&(b&&(c=f.contains(this,b)),c||(f.event.handle.apply(this,arguments),a.type=d))},F=function(a){a.type=a.data,f.event.handle.apply(this,arguments)};f.each({mouseenter:"mouseover",mouseleave:"mouseout"},function(a,b){f.event.special[a]={setup:function(c){f.event.add(this,b,c&&c.selector?F:E,a)},teardown:function(a){f.event.remove(this,b,a&&a.selector?F:E)}}}),f.support.submitBubbles||(f.event.special.submit={setup:function(a,b){if(!f.nodeName(this,"form"))f.event.add(this,"click.specialSubmit",function(a){var b=a.target,c=f.nodeName(b,"input")||f.nodeName(b,"button")?b.type:"";(c==="submit"||c==="image")&&f(b).closest("form").length&&J("submit",this,arguments)}),f.event.add(this,"keypress.specialSubmit",function(a){var b=a.target,c=f.nodeName(b,"input")||f.nodeName(b,"button")?b.type:"";(c==="text"||c==="password")&&f(b).closest("form").length&&a.keyCode===13&&J("submit",this,arguments)});else return!1},teardown:function(a){f.event.remove(this,".specialSubmit")}});if(!f.support.changeBubbles){var G,H=function(a){var b=f.nodeName(a,"input")?a.type:"",c=a.value;b==="radio"||b==="checkbox"?c=a.checked:b==="select-multiple"?c=a.selectedIndex>-1?f.map(a.options,function(a){return a.selected}).join("-"):"":f.nodeName(a,"select")&&(c=a.selectedIndex);return c},I=function(c){var d=c.target,e,g;if(!!x.test(d.nodeName)&&!d.readOnly){e=f._data(d,"_change_data"),g=H(d),(c.type!=="focusout"||d.type!=="radio")&&f._data(d,"_change_data",g);if(e===b||g===e)return;if(e!=null||g)c.type="change",c.liveFired=b,f.event.trigger(c,arguments[1],d)}};f.event.special.change={filters:{focusout:I,beforedeactivate:I,click:function(a){var b=a.target,c=f.nodeName(b,"input")?b.type:"";(c==="radio"||c==="checkbox"||f.nodeName(b,"select"))&&I.call(this,a)},keydown:function(a){var b=a.target,c=f.nodeName(b,"input")?b.type:"";(a.keyCode===13&&!f.nodeName(b,"textarea")||a.keyCode===32&&(c==="checkbox"||c==="radio")||c==="select-multiple")&&I.call(this,a)},beforeactivate:function(a){var b=a.target;f._data(b,"_change_data",H(b))}},setup:function(a,b){if(this.type==="file")return!1;for(var c in G)f.event.add(this,c+".specialChange",G[c]);return x.test(this.nodeName)},teardown:function(a){f.event.remove(this,".specialChange");return x.test(this.nodeName)}},G=f.event.special.change.filters,G.focus=G.beforeactivate}f.support.focusinBubbles||f.each({focus:"focusin",blur:"focusout"},function(a,b){function e(a){var c=f.event.fix(a);c.type=b,c.originalEvent={},f.event.trigger(c,null,c.target),c.isDefaultPrevented()&&a.preventDefault()}var d=0;f.event.special[b]={setup:function(){d++===0&&c.addEventListener(a,e,!0)},teardown:function(){--d===0&&c.removeEventListener(a,e,!0)}}}),f.each(["bind","one"],function(a,c){f.fn[c]=function(a,d,e){var g;if(typeof a=="object"){for(var h in a)this[c](h,d,a[h],e);return this}if(arguments.length===2||d===!1)e=d,d=b;c==="one"?(g=function(a){f(this).unbind(a,g);return e.apply(this,arguments)},g.guid=e.guid||f.guid++):g=e;if(a==="unload"&&c!=="one")this.one(a,d,e);else for(var i=0,j=this.length;i<j;i++)f.event.add(this[i],a,g,d);return this}}),f.fn.extend({unbind:function(a,b){if(typeof a=="object"&&!a.preventDefault)for(var c in a)this.unbind(c,a[c]);else for(var d=0,e=this.length;d<e;d++)f.event.remove(this[d],a,b);return this},delegate:function(a,b,c,d){return this.live(b,c,d,a)},undelegate:function(a,b,c){return arguments.length===0?this.unbind("live"):this.die(b,null,c,a)},trigger:function(a,b){return this.each(function(){f.event.trigger(a,b,this)})},triggerHandler:function(a,b){if(this[0])return f.event.trigger(a,b,this[0],!0)},toggle:function(a){var b=arguments,c=a.guid||f.guid++,d=0,e=function(c){var e=(f.data(this,"lastToggle"+a.guid)||0)%d;f.data(this,"lastToggle"+a.guid,e+1),c.preventDefault();return b[e].apply(this,arguments)||!1};e.guid=c;while(d<b.length)b[d++].guid=c;return this.click(e)},hover:function(a,b){return this.mouseenter(a).mouseleave(b||a)}});var K={focus:"focusin",blur:"focusout",mouseenter:"mouseover",mouseleave:"mouseout"};f.each(["live","die"],function(a,c){f.fn[c]=function(a,d,e,g){var h,i=0,j,k,l,m=g||this.selector,n=g?this:f(this.context);if(typeof a=="object"&&!a.preventDefault){for(var o in a)n[c](o,d,a[o],m);return this}if(c==="die"&&!a&&g&&g.charAt(0)==="."){n.unbind(g);return this}if(d===!1||f.isFunction(d))e=d||C,d=b;a=(a||"").split(" ");while((h=a[i++])!=null){j=w.exec(h),k="",j&&(k=j[0],h=h.replace(w,""));if(h==="hover"){a.push("mouseenter"+k,"mouseleave"+k);continue}l=h,K[h]?(a.push(K[h]+k),h=h+k):h=(K[h]||h)+k;if(c==="live")for(var p=0,q=n.length;p<q;p++)f.event.add(n[p],"live."+M(h,m),{data:d,selector:m,handler:e,origType:h,origHandler:e,preType:l});else n.unbind("live."+M(h,m),e)}return this}}),f.each("blur focus focusin focusout load resize scroll unload click dblclick mousedown mouseup mousemove mouseover mouseout mouseenter mouseleave change select submit keydown keypress keyup error".split(" "),function(a,b){f.fn[b]=function(a,c){c==null&&(c=a,a=null);return arguments.length>0?this.bind(b,a,c):this.trigger(b)},f.attrFn&&(f.attrFn[b]=!0)}),function(){function u(a,b,c,d,e,f){for(var g=0,h=d.length;g<h;g++){var i=d[g];if(i){var j=!1;i=i[a];while(i){if(i.sizcache===c){j=d[i.sizset];break}if(i.nodeType===1){f||(i.sizcache=c,i.sizset=g);if(typeof b!="string"){if(i===b){j=!0;break}}else if(k.filter(b,[i]).length>0){j=i;break}}i=i[a]}d[g]=j}}}function t(a,b,c,d,e,f){for(var g=0,h=d.length;g<h;g++){var i=d[g];if(i){var j=!1;i=i[a];while(i){if(i.sizcache===c){j=d[i.sizset];break}i.nodeType===1&&!f&&(i.sizcache=c,i.sizset=g);if(i.nodeName.toLowerCase()===b){j=i;break}i=i[a]}d[g]=j}}}var a=/((?:\((?:\([^()]+\)|[^()]+)+\)|\[(?:\[[^\[\]]*\]|['"][^'"]*['"]|[^\[\]'"]+)+\]|\\.|[^ >+~,(\[\\]+)+|[>+~])(\s*,\s*)?((?:.|\r|\n)*)/g,d=0,e=Object.prototype.toString,g=!1,h=!0,i=/\\/g,j=/\W/;[0,0].sort(function(){h=!1;return 0});var k=function(b,d,f,g){f=f||[],d=d||c;var h=d;if(d.nodeType!==1&&d.nodeType!==9)return[];if(!b||typeof b!="string")return f;var i,j,n,o,q,r,s,t,u=!0,w=k.isXML(d),x=[],y=b;do{a.exec(""),i=a.exec(y);if(i){y=i[3],x.push(i[1]);if(i[2]){o=i[3];break}}}while(i);if(x.length>1&&m.exec(b))if(x.length===2&&l.relative[x[0]])j=v(x[0]+x[1],d);else{j=l.relative[x[0]]?[d]:k(x.shift(),d);while(x.length)b=x.shift(),l.relative[b]&&(b+=x.shift()),j=v(b,j)}else{!g&&x.length>1&&d.nodeType===9&&!w&&l.match.ID.test(x[0])&&!l.match.ID.test(x[x.length-1])&&(q=k.find(x.shift(),d,w),d=q.expr?k.filter(q.expr,q.set)[0]:q.set[0]);if(d){q=g?{expr:x.pop(),set:p(g)}:k.find(x.pop(),x.length===1&&(x[0]==="~"||x[0]==="+")&&d.parentNode?d.parentNode:d,w),j=q.expr?k.filter(q.expr,q.set):q.set,x.length>0?n=p(j):u=!1;while(x.length)r=x.pop(),s=r,l.relative[r]?s=x.pop():r="",s==null&&(s=d),l.relative[r](n,s,w)}else n=x=[]}n||(n=j),n||k.error(r||b);if(e.call(n)==="[object Array]")if(!u)f.push.apply(f,n);else if(d&&d.nodeType===1)for(t=0;n[t]!=null;t++)n[t]&&(n[t]===!0||n[t].nodeType===1&&k.contains(d,n[t]))&&f.push(j[t]);else for(t=0;n[t]!=null;t++)n[t]&&n[t].nodeType===1&&f.push(j[t]);else p(n,f);o&&(k(o,h,f,g),k.uniqueSort(f));return f};k.uniqueSort=function(a){if(r){g=h,a.sort(r);if(g)for(var b=1;b<a.length;b++)a[b]===a[b-1]&&a.splice(b--,1)}return a},k.matches=function(a,b){return k(a,null,null,b)},k.matchesSelector=function(a,b){return k(b,null,null,[a]).length>0},k.find=function(a,b,c){var d;if(!a)return[];for(var e=0,f=l.order.length;e<f;e++){var g,h=l.order[e];if(g=l.leftMatch[h].exec(a)){var j=g[1];g.splice(1,1);if(j.substr(j.length-1)!=="\\"){g[1]=(g[1]||"").replace(i,""),d=l.find[h](g,b,c);if(d!=null){a=a.replace(l.match[h],"");break}}}}d||(d=typeof b.getElementsByTagName!="undefined"?b.getElementsByTagName("*"):[]);return{set:d,expr:a}},k.filter=function(a,c,d,e){var f,g,h=a,i=[],j=c,m=c&&c[0]&&k.isXML(c[0]);while(a&&c.length){for(var n in l.filter)if((f=l.leftMatch[n].exec(a))!=null&&f[2]){var o,p,q=l.filter[n],r=f[1];g=!1,f.splice(1,1);if(r.substr(r.length-1)==="\\")continue;j===i&&(i=[]);if(l.preFilter[n]){f=l.preFilter[n](f,j,d,i,e,m);if(!f)g=o=!0;else if(f===!0)continue}if(f)for(var s=0;(p=j[s])!=null;s++)if(p){o=q(p,f,s,j);var t=e^!!o;d&&o!=null?t?g=!0:j[s]=!1:t&&(i.push(p),g=!0)}if(o!==b){d||(j=i),a=a.replace(l.match[n],"");if(!g)return[];break}}if(a===h)if(g==null)k.error(a);else break;h=a}return j},k.error=function(a){throw"Syntax error, unrecognized expression: "+a};var l=k.selectors={order:["ID","NAME","TAG"],match:{ID:/#((?:[\w\u00c0-\uFFFF\-]|\\.)+)/,CLASS:/\.((?:[\w\u00c0-\uFFFF\-]|\\.)+)/,NAME:/\[name=['"]*((?:[\w\u00c0-\uFFFF\-]|\\.)+)['"]*\]/,ATTR:/\[\s*((?:[\w\u00c0-\uFFFF\-]|\\.)+)\s*(?:(\S?=)\s*(?:(['"])(.*?)\3|(#?(?:[\w\u00c0-\uFFFF\-]|\\.)*)|)|)\s*\]/,TAG:/^((?:[\w\u00c0-\uFFFF\*\-]|\\.)+)/,CHILD:/:(only|nth|last|first)-child(?:\(\s*(even|odd|(?:[+\-]?\d+|(?:[+\-]?\d*)?n\s*(?:[+\-]\s*\d+)?))\s*\))?/,POS:/:(nth|eq|gt|lt|first|last|even|odd)(?:\((\d*)\))?(?=[^\-]|$)/,PSEUDO:/:((?:[\w\u00c0-\uFFFF\-]|\\.)+)(?:\((['"]?)((?:\([^\)]+\)|[^\(\)]*)+)\2\))?/},leftMatch:{},attrMap:{"class":"className","for":"htmlFor"},attrHandle:{href:function(a){return a.getAttribute("href")},type:function(a){return a.getAttribute("type")}},relative:{"+":function(a,b){var c=typeof b=="string",d=c&&!j.test(b),e=c&&!d;d&&(b=b.toLowerCase());for(var f=0,g=a.length,h;f<g;f++)if(h=a[f]){while((h=h.previousSibling)&&h.nodeType!==1);a[f]=e||h&&h.nodeName.toLowerCase()===b?h||!1:h===b}e&&k.filter(b,a,!0)},">":function(a,b){var c,d=typeof b=="string",e=0,f=a.length;if(d&&!j.test(b)){b=b.toLowerCase();for(;e<f;e++){c=a[e];if(c){var g=c.parentNode;a[e]=g.nodeName.toLowerCase()===b?g:!1}}}else{for(;e<f;e++)c=a[e],c&&(a[e]=d?c.parentNode:c.parentNode===b);d&&k.filter(b,a,!0)}},"":function(a,b,c){var e,f=d++,g=u;typeof b=="string"&&!j.test(b)&&(b=b.toLowerCase(),e=b,g=t),g("parentNode",b,f,a,e,c)},"~":function(a,b,c){var e,f=d++,g=u;typeof b=="string"&&!j.test(b)&&(b=b.toLowerCase(),e=b,g=t),g("previousSibling",b,f,a,e,c)}},find:{ID:function(a,b,c){if(typeof b.getElementById!="undefined"&&!c){var d=b.getElementById(a[1]);return d&&d.parentNode?[d]:[]}},NAME:function(a,b){if(typeof b.getElementsByName!="undefined"){var c=[],d=b.getElementsByName(a[1]);for(var e=0,f=d.length;e<f;e++)d[e].getAttribute("name")===a[1]&&c.push(d[e]);return c.length===0?null:c}},TAG:function(a,b){if(typeof b.getElementsByTagName!="undefined")return b.getElementsByTagName(a[1])}},preFilter:{CLASS:function(a,b,c,d,e,f){a=" "+a[1].replace(i,"")+" ";if(f)return a;for(var g=0,h;(h=b[g])!=null;g++)h&&(e^(h.className&&(" "+h.className+" ").replace(/[\t\n\r]/g," ").indexOf(a)>=0)?c||d.push(h):c&&(b[g]=!1));return!1},ID:function(a){return a[1].replace(i,"")},TAG:function(a,b){return a[1].replace(i,"").toLowerCase()},CHILD:function(a){if(a[1]==="nth"){a[2]||k.error(a[0]),a[2]=a[2].replace(/^\+|\s*/g,"");var b=/(-?)(\d*)(?:n([+\-]?\d*))?/.exec(a[2]==="even"&&"2n"||a[2]==="odd"&&"2n+1"||!/\D/.test(a[2])&&"0n+"+a[2]||a[2]);a[2]=b[1]+(b[2]||1)-0,a[3]=b[3]-0}else a[2]&&k.error(a[0]);a[0]=d++;return a},ATTR:function(a,b,c,d,e,f){var g=a[1]=a[1].replace(i,"");!f&&l.attrMap[g]&&(a[1]=l.attrMap[g]),a[4]=(a[4]||a[5]||"").replace(i,""),a[2]==="~="&&(a[4]=" "+a[4]+" ");return a},PSEUDO:function(b,c,d,e,f){if(b[1]==="not")if((a.exec(b[3])||"").length>1||/^\w/.test(b[3]))b[3]=k(b[3],null,null,c);else{var g=k.filter(b[3],c,d,!0^f);d||e.push.apply(e,g);return!1}else if(l.match.POS.test(b[0])||l.match.CHILD.test(b[0]))return!0;return b},POS:function(a){a.unshift(!0);return a}},filters:{enabled:function(a){return a.disabled===!1&&a.type!=="hidden"},disabled:function(a){return a.disabled===!0},checked:function(a){return a.checked===!0},selected:function(a){a.parentNode&&a.parentNode.selectedIndex;return a.selected===!0},parent:function(a){return!!a.firstChild},empty:function(a){return!a.firstChild},has:function(a,b,c){return!!k(c[3],a).length},header:function(a){return/h\d/i.test(a.nodeName)},text:function(a){var b=a.getAttribute("type"),c=a.type;return a.nodeName.toLowerCase()==="input"&&"text"===c&&(b===c||b===null)},radio:function(a){return a.nodeName.toLowerCase()==="input"&&"radio"===a.type},checkbox:function(a){return a.nodeName.toLowerCase()==="input"&&"checkbox"===a.type},file:function(a){return a.nodeName.toLowerCase()==="input"&&"file"===a.type},password:function(a){return a.nodeName.toLowerCase()==="input"&&"password"===a.type},submit:function(a){var b=a.nodeName.toLowerCase();return(b==="input"||b==="button")&&"submit"===a.type},image:function(a){return a.nodeName.toLowerCase()==="input"&&"image"===a.type},reset:function(a){var b=a.nodeName.toLowerCase();return(b==="input"||b==="button")&&"reset"===a.type},button:function(a){var b=a.nodeName.toLowerCase();return b==="input"&&"button"===a.type||b==="button"},input:function(a){return/input|select|textarea|button/i.test(a.nodeName)},focus:function(a){return a===a.ownerDocument.activeElement}},setFilters:{first:function(a,b){return b===0},last:function(a,b,c,d){return b===d.length-1},even:function(a,b){return b%2===0},odd:function(a,b){return b%2===1},lt:function(a,b,c){return b<c[3]-0},gt:function(a,b,c){return b>c[3]-0},nth:function(a,b,c){return c[3]-0===b},eq:function(a,b,c){return c[3]-0===b}},filter:{PSEUDO:function(a,b,c,d){var e=b[1],f=l.filters[e];if(f)return f(a,c,b,d);if(e==="contains")return(a.textContent||a.innerText||k.getText([a])||"").indexOf(b[3])>=0;if(e==="not"){var g=b[3];for(var h=0,i=g.length;h<i;h++)if(g[h]===a)return!1;return!0}k.error(e)},CHILD:function(a,b){var c=b[1],d=a;switch(c){case"only":case"first":while(d=d.previousSibling)if(d.nodeType===1)return!1;if(c==="first")return!0;d=a;case"last":while(d=d.nextSibling)if(d.nodeType===1)return!1;return!0;case"nth":var e=b[2],f=b[3];if(e===1&&f===0)return!0;var g=b[0],h=a.parentNode;if(h&&(h.sizcache!==g||!a.nodeIndex)){var i=0;for(d=h.firstChild;d;d=d.nextSibling)d.nodeType===1&&(d.nodeIndex=++i);h.sizcache=g}var j=a.nodeIndex-f;return e===0?j===0:j%e===0&&j/e>=0}},ID:function(a,b){return a.nodeType===1&&a.getAttribute("id")===b},TAG:function(a,b){return b==="*"&&a.nodeType===1||a.nodeName.toLowerCase()===b},CLASS:function(a,b){return(" "+(a.className||a.getAttribute("class"))+" ").indexOf(b)>-1},ATTR:function(a,b){var c=b[1],d=l.attrHandle[c]?l.attrHandle[c](a):a[c]!=null?a[c]:a.getAttribute(c),e=d+"",f=b[2],g=b[4];return d==null?f==="!=":f==="="?e===g:f==="*="?e.indexOf(g)>=0:f==="~="?(" "+e+" ").indexOf(g)>=0:g?f==="!="?e!==g:f==="^="?e.indexOf(g)===0:f==="$="?e.substr(e.length-g.length)===g:f==="|="?e===g||e.substr(0,g.length+1)===g+"-":!1:e&&d!==!1},POS:function(a,b,c,d){var e=b[2],f=l.setFilters[e];if(f)return f(a,c,b,d)}}},m=l.match.POS,n=function(a,b){return"\\"+(b-0+1)};for(var o in l.match)l.match[o]=new RegExp(l.match[o].source+/(?![^\[]*\])(?![^\(]*\))/.source),l.leftMatch[o]=new RegExp(/(^(?:.|\r|\n)*?)/.source+l.match[o].source.replace(/\\(\d+)/g,n));var p=function(a,b){a=Array.prototype.slice.call(a,0);if(b){b.push.apply(b,a);return b}return a};try{Array.prototype.slice.call(c.documentElement.childNodes,0)[0].nodeType}catch(q){p=function(a,b){var c=0,d=b||[];if(e.call(a)==="[object Array]")Array.prototype.push.apply(d,a);else if(typeof a.length=="number")for(var f=a.length;c<f;c++)d.push(a[c]);else for(;a[c];c++)d.push(a[c]);return d}}var r,s;c.documentElement.compareDocumentPosition?r=function(a,b){if(a===b){g=!0;return 0}if(!a.compareDocumentPosition||!b.compareDocumentPosition)return a.compareDocumentPosition?-1:1;return a.compareDocumentPosition(b)&4?-1:1}:(r=function(a,b){if(a===b){g=!0;return 0}if(a.sourceIndex&&b.sourceIndex)return a.sourceIndex-b.sourceIndex;var c,d,e=[],f=[],h=a.parentNode,i=b.parentNode,j=h;if(h===i)return s(a,b);if(!h)return-1;if(!i)return 1;while(j)e.unshift(j),j=j.parentNode;j=i;while(j)f.unshift(j),j=j.parentNode;c=e.length,d=f.length;for(var k=0;k<c&&k<d;k++)if(e[k]!==f[k])return s(e[k],f[k]);return k===c?s(a,f[k],-1):s(e[k],b,1)},s=function(a,b,c){if(a===b)return c;var d=a.nextSibling;while(d){if(d===b)return-1;d=d.nextSibling}return 1}),k.getText=function(a){var b="",c;for(var d=0;a[d];d++)c=a[d],c.nodeType===3||c.nodeType===4?b+=c.nodeValue:c.nodeType!==8&&(b+=k.getText(c.childNodes));return b},function(){var a=c.createElement("div"),d="script"+(new Date).getTime(),e=c.documentElement;a.innerHTML="<a name='"+d+"'/>",e.insertBefore(a,e.firstChild),c.getElementById(d)&&(l.find.ID=function(a,c,d){if(typeof c.getElementById!="undefined"&&!d){var e=c.getElementById(a[1]);return e?e.id===a[1]||typeof e.getAttributeNode!="undefined"&&e.getAttributeNode("id").nodeValue===a[1]?[e]:b:[]}},l.filter.ID=function(a,b){var c=typeof a.getAttributeNode!="undefined"&&a.getAttributeNode("id");return a.nodeType===1&&c&&c.nodeValue===b}),e.removeChild(a),e=a=null}(),function(){var a=c.createElement("div");a.appendChild(c.createComment("")),a.getElementsByTagName("*").length>0&&(l.find.TAG=function(a,b){var c=b.getElementsByTagName(a[1]);if(a[1]==="*"){var d=[];for(var e=0;c[e];e++)c[e].nodeType===1&&d.push(c[e]);c=d}return c}),a.innerHTML="<a href='#'></a>",a.firstChild&&typeof a.firstChild.getAttribute!="undefined"&&a.firstChild.getAttribute("href")!=="#"&&(l.attrHandle.href=function(a){return a.getAttribute("href",2)}),a=null}(),c.querySelectorAll&&function(){var a=k,b=c.createElement("div"),d="__sizzle__";b.innerHTML="<p class='TEST'></p>";if(!b.querySelectorAll||b.querySelectorAll(".TEST").length!==0){k=function(b,e,f,g){e=e||c;if(!g&&!k.isXML(e)){var h=/^(\w+$)|^\.([\w\-]+$)|^#([\w\-]+$)/.exec(b);if(h&&(e.nodeType===1||e.nodeType===9)){if(h[1])return p(e.getElementsByTagName(b),f);if(h[2]&&l.find.CLASS&&e.getElementsByClassName)return p(e.getElementsByClassName(h[2]),f)}if(e.nodeType===9){if(b==="body"&&e.body)return p([e.body],f);if(h&&h[3]){var i=e.getElementById(h[3]);if(!i||!i.parentNode)return p([],f);if(i.id===h[3])return p([i],f)}try{return p(e.querySelectorAll(b),f)}catch(j){}}else if(e.nodeType===1&&e.nodeName.toLowerCase()!=="object"){var m=e,n=e.getAttribute("id"),o=n||d,q=e.parentNode,r=/^\s*[+~]/.test(b);n?o=o.replace(/'/g,"\\$&"):e.setAttribute("id",o),r&&q&&(e=e.parentNode);try{if(!r||q)return p(e.querySelectorAll("[id='"+o+"'] "+b),f)}catch(s){}finally{n||m.removeAttribute("id")}}}return a(b,e,f,g)};for(var e in a)k[e]=a[e];b=null}}(),function(){var a=c.documentElement,b=a.matchesSelector||a.mozMatchesSelector||a.webkitMatchesSelector||a.msMatchesSelector;if(b){var d=!b.call(c.createElement("div"),"div"),e=!1;try{b.call(c.documentElement,"[test!='']:sizzle")}catch(f){e=!0}k.matchesSelector=function(a,c){c=c.replace(/\=\s*([^'"\]]*)\s*\]/g,"='$1']");if(!k.isXML(a))try{if(e||!l.match.PSEUDO.test(c)&&!/!=/.test(c)){var f=b.call(a,c);if(f||!d||a.document&&a.document.nodeType!==11)return f}}catch(g){}return k(c,null,null,[a]).length>0}}}(),function(){var a=c.createElement("div");a.innerHTML="<div class='test e'></div><div class='test'></div>";if(!!a.getElementsByClassName&&a.getElementsByClassName("e").length!==0){a.lastChild.className="e";if(a.getElementsByClassName("e").length===1)return;l.order.splice(1,0,"CLASS"),l.find.CLASS=function(a,b,c){if(typeof b.getElementsByClassName!="undefined"&&!c)return b.getElementsByClassName(a[1])},a=null}}(),c.documentElement.contains?k.contains=function(a,b){return a!==b&&(a.contains?a.contains(b):!0)}:c.documentElement.compareDocumentPosition?k.contains=function(a,b){return!!(a.compareDocumentPosition(b)&16)}:k.contains=function(){return!1},k.isXML=function(a){var b=(a?a.ownerDocument||a:0).documentElement;return b?b.nodeName!=="HTML":!1};var v=function(a,b){var c,d=[],e="",f=b.nodeType?[b]:b;while(c=l.match.PSEUDO.exec(a))e+=c[0],a=a.replace(l.match.PSEUDO,"");a=l.relative[a]?a+"*":a;for(var g=0,h=f.length;g<h;g++)k(a,f[g],d);return k.filter(e,d)};f.find=k,f.expr=k.selectors,f.expr[":"]=f.expr.filters,f.unique=k.uniqueSort,f.text=k.getText,f.isXMLDoc=k.isXML,f.contains=k.contains}();var N=/Until$/,O=/^(?:parents|prevUntil|prevAll)/,P=/,/,Q=/^.[^:#\[\.,]*$/,R=Array.prototype.slice,S=f.expr.match.POS,T={children:!0,contents:!0,next:!0,prev:!0};f.fn.extend({find:function(a){var b=this,c,d;if(typeof a!="string")return f(a).filter(function(){for(c=0,d=b.length;c<d;c++)if(f.contains(b[c],this))return!0});var e=this.pushStack("","find",a),g,h,i;for(c=0,d=this.length;c<d;c++){g=e.length,f.find(a,this[c],e);if(c>0)for(h=g;h<e.length;h++)for(i=0;i<g;i++)if(e[i]===e[h]){e.splice(h--,1);break}}return e},has:function(a){var b=f(a);return this.filter(function(){for(var a=0,c=b.length;a<c;a++)if(f.contains(this,b[a]))return!0})},not:function(a){return this.pushStack(V(this,a,!1),"not",a)},filter:function(a){return this.pushStack(V(this,a,!0),"filter",a)},is:function(a){return!!a&&(typeof a=="string"?f.filter(a,this).length>0:this.filter(a).length>0)},closest:function(a,b){var c=[],d,e,g=this[0];if(f.isArray(a)){var h,i,j={},k=1;if(g&&a.length){for(d=0,e=a.length;d<e;d++)i=a[d],j[i]||(j[i]=S.test(i)?f(i,b||this.context):i);while(g&&g.ownerDocument&&g!==b){for(i in j)h=j[i],(h.jquery?h.index(g)>-1:f(g).is(h))&&c.push({selector:i,elem:g,level:k});g=g.parentNode,k++}}return c}var l=S.test(a)||typeof a!="string"?f(a,b||this.context):0;for(d=0,e=this.length;d<e;d++){g=this[d];while(g){if(l?l.index(g)>-1:f.find.matchesSelector(g,a)){c.push(g);break}g=g.parentNode;if(!g||!g.ownerDocument||g===b||g.nodeType===11)break}}c=c.length>1?f.unique(c):c;return this.pushStack(c,"closest",a)},index:function(a){if(!a)return this[0]&&this[0].parentNode?this.prevAll().length:-1;if(typeof a=="string")return f.inArray(this[0],f(a));return f.inArray(a.jquery?a[0]:a,this)},add:function(a,b){var c=typeof a=="string"?f(a,b):f.makeArray(a&&a.nodeType?[a]:a),d=f.merge(this.get(),c);return this.pushStack(U(c[0])||U(d[0])?d:f.unique(d))},andSelf:function(){return this.add(this.prevObject)}}),f.each({parent:function(a){var b=a.parentNode;return b&&b.nodeType!==11?b:null},parents:function(a){return f.dir(a,"parentNode")},parentsUntil:function(a,b,c){return f.dir(a,"parentNode",c)},next:function(a){return f.nth(a,2,"nextSibling")},prev:function(a){return f.nth(a,2,"previousSibling")},nextAll:function(a){return f.dir(a,"nextSibling")},prevAll:function(a){return f.dir(a,"previousSibling")},nextUntil:function(a,b,c){return f.dir(a,"nextSibling",c)},prevUntil:function(a,b,c){return f.dir(a,"previousSibling",c)},siblings:function(a){return f.sibling(a.parentNode.firstChild,a)},children:function(a){return f.sibling(a.firstChild)},contents:function(a){return f.nodeName(a,"iframe")?a.contentDocument||a.contentWindow.document:f.makeArray(a.childNodes)}},function(a,b){f.fn[a]=function(c,d){var e=f.map(this,b,c),g=R.call(arguments);N.test(a)||(d=c),d&&typeof d=="string"&&(e=f.filter(d,e)),e=this.length>1&&!T[a]?f.unique(e):e,(this.length>1||P.test(d))&&O.test(a)&&(e=e.reverse());return this.pushStack(e,a,g.join(","))}}),f.extend({filter:function(a,b,c){c&&(a=":not("+a+")");return b.length===1?f.find.matchesSelector(b[0],a)?[b[0]]:[]:f.find.matches(a,b)},dir:function(a,c,d){var e=[],g=a[c];while(g&&g.nodeType!==9&&(d===b||g.nodeType!==1||!f(g).is(d)))g.nodeType===1&&e.push(g),g=g[c];return e},nth:function(a,b,c,d){b=b||1;var e=0;for(;a;a=a[c])if(a.nodeType===1&&++e===b)break;return a},sibling:function(a,b){var c=[];for(;a;a=a.nextSibling)a.nodeType===1&&a!==b&&c.push(a);return c}});var W=/ jQuery\d+="(?:\d+|null)"/g,X=/^\s+/,Y=/<(?!area|br|col|embed|hr|img|input|link|meta|param)(([\w:]+)[^>]*)\/>/ig,Z=/<([\w:]+)/,$=/<tbody/i,_=/<|&#?\w+;/,ba=/<(?:script|object|embed|option|style)/i,bb=/checked\s*(?:[^=]|=\s*.checked.)/i,bc=/\/(java|ecma)script/i,bd=/^\s*<!(?:\[CDATA\[|\-\-)/,be={option:[1,"<select multiple='multiple'>","</select>"],legend:[1,"<fieldset>","</fieldset>"],thead:[1,"<table>","</table>"],tr:[2,"<table><tbody>","</tbody></table>"],td:[3,"<table><tbody><tr>","</tr></tbody></table>"],col:[2,"<table><tbody></tbody><colgroup>","</colgroup></table>"],area:[1,"<map>","</map>"],_default:[0,"",""]};be.optgroup=be.option,be.tbody=be.tfoot=be.colgroup=be.caption=be.thead,be.th=be.td,f.support.htmlSerialize||(be._default=[1,"div<div>","</div>"]),f.fn.extend({text:function(a){if(f.isFunction(a))return this.each(function(b){var c=f(this);c.text(a.call(this,b,c.text()))});if(typeof a!="object"&&a!==b)return this.empty().append((this[0]&&this[0].ownerDocument||c).createTextNode(a));return f.text(this)},wrapAll:function(a){if(f.isFunction(a))return this.each(function(b){f(this).wrapAll(a.call(this,b))});if(this[0]){var b=f(a,this[0].ownerDocument).eq(0).clone(!0);this[0].parentNode&&b.insertBefore(this[0]),b.map(function(){var a=this;while(a.firstChild&&a.firstChild.nodeType===1)a=a.firstChild;return a}).append(this)}return this},wrapInner:function(a){if(f.isFunction(a))return this.each(function(b){f(this).wrapInner(a.call(this,b))});return this.each(function(){var b=f(this),c=b.contents();c.length?c.wrapAll(a):b.append(a)})},wrap:function(a){return this.each(function(){f(this).wrapAll(a)})},unwrap:function(){return this.parent().each(function(){f.nodeName(this,"body")||f(this).replaceWith(this.childNodes)}).end()},append:function(){return this.domManip(arguments,!0,function(a){this.nodeType===1&&this.appendChild(a)})},prepend:function(){return this.domManip(arguments,!0,function(a){this.nodeType===1&&this.insertBefore(a,this.firstChild)})},before:function(){if(this[0]&&this[0].parentNode)return this.domManip(arguments,!1,function(a){this.parentNode.insertBefore(a,this)});if(arguments.length){var a=f(arguments[0]);a.push.apply(a,this.toArray());return this.pushStack(a,"before",arguments)}},after:function(){if(this[0]&&this[0].parentNode)return this.domManip(arguments,!1,function(a){this.parentNode.insertBefore(a,this.nextSibling)});if(arguments.length){var a=this.pushStack(this,"after",arguments);a.push.apply(a,f(arguments[0]).toArray());return a}},remove:function(a,b){for(var c=0,d;(d=this[c])!=null;c++)if(!a||f.filter(a,[d]).length)!b&&d.nodeType===1&&(f.cleanData(d.getElementsByTagName("*")),f.cleanData([d])),d.parentNode&&d.parentNode.removeChild(d);return this},empty:function(){for(var a=0,b;(b=this[a])!=null;a++){b.nodeType===1&&f.cleanData(b.getElementsByTagName("*"));while(b.firstChild)b.removeChild(b.firstChild)}return this},clone:function(a,b){a=a==null?!1:a,b=b==null?a:b;return this.map(function(){return f.clone(this,a,b)})},html:function(a){if(a===b)return this[0]&&this[0].nodeType===1?this[0].innerHTML.replace(W,""):null;if(typeof a=="string"&&!ba.test(a)&&(f.support.leadingWhitespace||!X.test(a))&&!be[(Z.exec(a)||["",""])[1].toLowerCase()]){a=a.replace(Y,"<$1></$2>");try{for(var c=0,d=this.length;c<d;c++)this[c].nodeType===1&&(f.cleanData(this[c].getElementsByTagName("*")),this[c].innerHTML=a)}catch(e){this.empty().append(a)}}else f.isFunction(a)?this.each(function(b){var c=f(this);c.html(a.call(this,b,c.html()))}):this.empty().append(a);return this},replaceWith:function(a){if(this[0]&&this[0].parentNode){if(f.isFunction(a))return this.each(function(b){var c=f(this),d=c.html();c.replaceWith(a.call(this,b,d))});typeof a!="string"&&(a=f(a).detach());return this.each(function(){var b=this.nextSibling,c=this.parentNode;f(this).remove(),b?f(b).before(a):f(c).append(a)})}return this.length?this.pushStack(f(f.isFunction(a)?a():a),"replaceWith",a):this},detach:function(a){return this.remove(a,!0)},domManip:function(a,c,d){var e,g,h,i,j=a[0],k=[];if(!f.support.checkClone&&arguments.length===3&&typeof j=="string"&&bb.test(j))return this.each(function(){f(this).domManip(a,c,d,!0)});if(f.isFunction(j))return this.each(function(e){var g=f(this);a[0]=j.call(this,e,c?g.html():b),g.domManip(a,c,d)});if(this[0]){i=j&&j.parentNode,f.support.parentNode&&i&&i.nodeType===11&&i.childNodes.length===this.length?e={fragment:i}:e=f.buildFragment(a,this,k),h=e.fragment,h.childNodes.length===1?g=h=h.firstChild:g=h.firstChild;if(g){c=c&&f.nodeName(g,"tr");for(var l=0,m=this.length,n=m-1;l<m;l++)d.call(c?bf(this[l],g):this[l],e.cacheable||m>1&&l<n?f.clone(h,!0,!0):h)}k.length&&f.each(k,bl)}return this}}),f.buildFragment=function(a,b,d){var e,g,h,i;b&&b[0]&&(i=b[0].ownerDocument||b[0]),i.createDocumentFragment||(i=c),a.length===1&&typeof a[0]=="string"&&a[0].length<512&&i===c&&a[0].charAt(0)==="<"&&!ba.test(a[0])&&(f.support.checkClone||!bb.test(a[0]))&&(g=!0,h=f.fragments[a[0]],h&&h!==1&&(e=h)),e||(e=i.createDocumentFragment(),f.clean-(a,i,e,d)),g&&(f.fragments[a[0]]=h?e:1);return{fragment:e,cacheable:g}},f.fragments={},f.each({appendTo:"append",prependTo:"prepend",insertBefore:"before",insertAfter:"after",replaceAll:"replaceWith"},function(a,b){f.fn[a]=function(c){var d=[],e=f(c),g=this.length===1&&this[0].parentNode;if(g&&g.nodeType===11&&g.childNodes.length===1&&e.length===1){e[b](this[0]);return this}for(var h=0,i=e.length;h<i;h++){var j=(h>0?this.clone(!0):this).get();f(e[h])[b](j),d=d.concat(j)}return this.pushStack(d,a,e.selector)}}),f.extend({clone:function(a,b,c){var d=a.cloneNode(!0),e,g,h;if((!f.support.noCloneEvent||!f.support.noCloneChecked)&&(a.nodeType===1||a.nodeType===11)&&!f.isXMLDoc(a)){bh(a,d),e=bi(a),g=bi(d);for(h=0;e[h];++h)g[h]&&bh(e[h],g[h])}if(b){bg(a,d);if(c){e=bi(a),g=bi(d);for(h=0;e[h];++h)bg(e[h],g[h])}}e=g=null;return d},clean:function(a,b,d,e){var g;b=b||c,typeof b.createElement=="undefined"&&(b=b.ownerDocument||b[0]&&b[0].ownerDocument||c);var h=[],i;for(var j=0,k;(k=a[j])!=null;j++){typeof k=="number"&&(k+="");if(!k)continue;if(typeof k=="string")if(!_.test(k))k=b.createTextNode(k);else{k=k.replace(Y,"<$1></$2>");var l=(Z.exec(k)||["",""])[1].toLowerCase(),m=be[l]||be._default,n=m[0],o=b.createElement("div");o.innerHTML=m[1]+k+m[2];while(n--)o=o.lastChild;if(!f.support.tbody){var p=$.test(k),q=l==="table"&&!p?o.firstChild&&o.firstChild.childNodes:m[1]==="<table>"&&!p?o.childNodes:[];for(i=q.length-1;i>=0;--i)f.nodeName(q[i],"tbody")&&!q[i].childNodes.length&&q[i].parentNode.removeChild(q[i])}!f.support.leadingWhitespace&&X.test(k)&&o.insertBefore(b.createTextNode(X.exec(k)[0]),o.firstChild),k=o.childNodes}var r;if(!f.support.appendChecked)if(k[0]&&typeof (r=k.length)=="number")for(i=0;i<r;i++)bk(k[i]);else bk(k);k.nodeType?h.push(k):h=f.merge(h,k)}if(d){g=function(a){return!a.type||bc.test(a.type)};for(j=0;h[j];j++)if(e&&f.nodeName(h[j],"script")&&(!h[j].type||h[j].type.toLowerCase()==="text/javascript"))e.push(h[j].parentNode?h[j].parentNode.removeChild(h[j]):h[j]);else{if(h[j].nodeType===1){var s=f.grep(h[j].getElementsByTagName("script"),g);h.splice.apply(h,[j+1,0].concat(s))}d.appendChild(h[j])}}return h},cleanData:function(a){var b,c,d=f.cache,e=f.expando,g=f.event.special,h=f.support.deleteExpando;for(var i=0,j;(j=a[i])!=null;i++){if(j.nodeName&&f.noData[j.nodeName.toLowerCase()])continue;c=j[f.expando];if(c){b=d[c]&&d[c][e];if(b&&b.events){for(var k in b.events)g[k]?f.event.remove(j,k):f.removeEvent(j,k,b.handle);b.handle&&(b.handle.elem=null)}h?delete j[f.expando]:j.removeAttribute&&j.removeAttribute(f.expando),delete d[c]}}}});var bm=/alpha\([^)]*\)/i,bn=/opacity=([^)]*)/,bo=/([A-Z]|^ms)/g,bp=/^-?\d+(?:px)?$/i,bq=/^-?\d/,br=/^([\-+])=([\-+.\de]+)/,bs={position:"absolute",visibility:"hidden",display:"block"},bt=["Left","Right"],bu=["Top","Bottom"],bv,bw,bx;f.fn.css=function(a,c){if(arguments.length===2&&c===b)return this;return f.access(this,a,c,!0,function(a,c,d){return d!==b?f.style(a,c,d):f.css(a,c)})},f.extend({cssHooks:{opacity:{get:function(a,b){if(b){var c=bv(a,"opacity","opacity");return c===""?"1":c}return a.style.opacity}}},cssNumber:{fillOpacity:!0,fontWeight:!0,lineHeight:!0,opacity:!0,orphans:!0,widows:!0,zIndex:!0,zoom:!0},cssProps:{"float":f.support.cssFloat?"cssFloat":"styleFloat"},style:function(a,c,d,e){if(!!a&&a.nodeType!==3&&a.nodeType!==8&&!!a.style){var g,h,i=f.camelCase(c),j=a.style,k=f.cssHooks[i];c=f.cssProps[i]||i;if(d===b){if(k&&"get"in k&&(g=k.get(a,!1,e))!==b)return g;return j[c]}h=typeof d,h==="string"&&(g=br.exec(d))&&(d=+(g[1]+1)*+g[2]+parseFloat(f.css(a,c)),h="number");if(d==null||h==="number"&&isNaN(d))return;h==="number"&&!f.cssNumber[i]&&(d+="px");if(!k||!("set"in k)||(d=k.set(a,d))!==b)try{j[c]=d}catch(l){}}},css:function(a,c,d){var e,g;c=f.camelCase(c),g=f.cssHooks[c],c=f.cssProps[c]||c,c==="cssFloat"&&(c="float");if(g&&"get"in g&&(e=g.get(a,!0,d))!==b)return e;if(bv)return bv(a,c)},swap:function(a,b,c){var d={};for(var e in b)d[e]=a.style[e],a.style[e]=b[e];c.call(a);for(e in b)a.style[e]=d[e]}}),f.curCSS=f.css,f.each(["height","width"],function(a,b){f.cssHooks[b]={get:function(a,c,d){var e;if(c){if(a.offsetWidth!==0)return by(a,b,d);f.swap(a,bs,function(){e=by(a,b,d)});return e}},set:function(a,b){if(!bp.test(b))return b;b=parseFloat(b);if(b>=0)return b+"px"}}}),f.support.opacity||(f.cssHooks.opacity={get:function(a,b){return bn.test((b&&a.currentStyle?a.currentStyle.filter:a.style.filter)||"")?parseFloat(RegExp.$1)/100+"":b?"1":""},set:function(a,b){var c=a.style,d=a.currentStyle,e=f.isNaN(b)?"":"alpha(opacity="+b*100+")",g=d&&d.filter||c.filter||"";c.zoom=1;if(b>=1&&f.trim(g.replace(bm,""))===""){c.removeAttribute("filter");if(d&&!d.filter)return}c.filter=bm.test(g)?g.replace(bm,e):g+" "+e}}),f(function(){f.support.reliableMarginRight||(f.cssHooks.marginRight={get:function(a,b){var c;f.swap(a,{display:"inline-block"},function(){b?c=bv(a,"margin-right","marginRight"):c=a.style.marginRight});return c}})}),c.defaultView&&c.defaultView.getComputedStyle&&(bw=function(a,c){var d,e,g;c=c.replace(bo,"-$1").toLowerCase();if(!(e=a.ownerDocument.defaultView))return b;if(g=e.getComputedStyle(a,null))d=g.getPropertyValue(c),d===""&&!f.contains(a.ownerDocument.documentElement,a)&&(d=f.style(a,c));return d}),c.documentElement.currentStyle&&(bx=function(a,b){var c,d=a.currentStyle&&a.currentStyle[b],e=a.runtimeStyle&&a.runtimeStyle[b],f=a.style;!bp.test(d)&&bq.test(d)&&(c=f.left,e&&(a.runtimeStyle.left=a.currentStyle.left),f.left=b==="fontSize"?"1em":d||0,d=f.pixelLeft+"px",f.left=c,e&&(a.runtimeStyle.left=e));return d===""?"auto":d}),bv=bw||bx,f.expr&&f.expr.filters&&(f.expr.filters.hidden=function(a){var b=a.offsetWidth,c=a.offsetHeight;return b===0&&c===0||!f.support.reliableHiddenOffsets&&(a.style.display||f.css(a,"display"))==="none"},f.expr.filters.visible=function(a){return!f.expr.filters.hidden(a)});var bz=/%20/g,bA=/\[\]$/,bB=/\r?\n/g,bC=/#.*$/,bD=/^(.*?):[ \t]*([^\r\n]*)\r?$/mg,bE=/^(?:color|date|datetime|datetime-local|email|hidden|month|number|password|range|search|tel|text|time|url|week)$/i,bF=/^(?:about|app|app\-storage|.+\-extension|file|res|widget):$/,bG=/^(?:GET|HEAD)$/,bH=/^\/\//,bI=/\?/,bJ=/<script\b[^<]*(?:(?!<\/script>)<[^<]*)*<\/script>/gi,bK=/^(?:select|textarea)/i,bL=/\s+/,bM=/([?&])_=[^&]*/,bN=/^([\w\+\.\-]+:)(?:\/\/([^\/?#:]*)(?::(\d+))?)?/,bO=f.fn.load,bP={},bQ={},bR,bS,bT=["*/"]+["*"];try{bR=e.href}catch(bU){bR=c.createElement("a"),bR.href="",bR=bR.href}bS=bN.exec(bR.toLowerCase())||[],f.fn.extend({load:function(a,c,d){if(typeof a!="string"&&bO)return bO.apply(this,arguments);if(!this.length)return this;var e=a.indexOf(" ");if(e>=0){var g=a.slice(e,a.length);a=a.slice(0,e)}var h="GET";c&&(f.isFunction(c)?(d=c,c=b):typeof c=="object"&&(c=f.param(c,f.ajaxSettings.traditional),h="POST"));var i=this;f.ajax({url:a,type:h,dataType:"html",data:c,complete:function(a,b,c){c=a.responseText,a.isResolved()&&(a.done(function(a){c=a}),i.html(g?f("<div>").append(c.replace(bJ,"")).find(g):c)),d&&i.each(d,[c,b,a])}});return this},serialize:function(){return f.param(this.serializeArray())},serializeArray:function(){return this.map(function(){return this.elements?f.makeArray(this.elements):this}).filter(function(){return this.name&&!this.disabled&&(this.checked||bK.test(this.nodeName)||bE.test(this.type))}).map(function(a,b){var c=f(this).val();return c==null?null:f.isArray(c)?f.map(c,function(a,c){return{name:b.name,value:a.replace(bB,"\r\n")}}):{name:b.name,value:c.replace(bB,"\r\n")}}).get()}}),f.each("ajaxStart ajaxStop ajaxComplete ajaxError ajaxSuccess ajaxSend".split(" "),function(a,b){f.fn[b]=function(a){return this.bind(b,a)}}),f.each(["get","post"],function(a,c){f[c]=function(a,d,e,g){f.isFunction(d)&&(g=g||e,e=d,d=b);return f.ajax({type:c,url:a,data:d,success:e,dataType:g})}}),f.extend({getScript:function(a,c){return f.get(a,b,c,"script")},getJSON:function(a,b,c){return f.get(a,b,c,"json")},ajaxSetup:function(a,b){b?bX(a,f.ajaxSettings):(b=a,a=f.ajaxSettings),bX(a,b);return a},ajaxSettings:{url:bR,isLocal:bF.test(bS[1]),global:!0,type:"GET",contentType:"application/x-www-form-urlencoded",processData:!0,async:!0,accepts:{xml:"application/xml, text/xml",html:"text/html",text:"text/plain",json:"application/json, text/javascript","*":bT},contents:{xml:/xml/,html:/html/,json:/json/},responseFields:{xml:"responseXML",text:"responseText"},converters:{"* text":a.String,"text html":!0,"text json":f.parseJSON,"text xml":f.parseXML},flatOptions:{context:!0,url:!0}},ajaxPrefilter:bV(bP),ajaxTransport:bV(bQ),ajax:function(a,c){function w(a,c,l,m){if(s!==2){s=2,q&&clearTimeout(q),p=b,n=m||"",v.readyState=a>0?4:0;var o,r,u,w=c,x=l?bZ(d,v,l):b,y,z;if(a>=200&&a<300||a===304){if(d.ifModified){if(y=v.getResponseHeader("Last-Modified"))f.lastModified[k]=y;if(z=v.getResponseHeader("Etag"))f.etag[k]=z}if(a===304)w="notmodified",o=!0;else try{r=b$(d,x),w="success",o=!0}catch(A){w="parsererror",u=A}}else{u=w;if(!w||a)w="error",a<0&&(a=0)}v.status=a,v.statusText=""+(c||w),o?h.resolveWith(e,[r,w,v]):h.rejectWith(e,[v,w,u]),v.statusCode(j),j=b,t&&g.trigger("ajax"+(o?"Success":"Error"),[v,d,o?r:u]),i.resolveWith(e,[v,w]),t&&(g.trigger("ajaxComplete",[v,d]),--f.active||f.event.trigger("ajaxStop"))}}typeof a=="object"&&(c=a,a=b),c=c||{};var d=f.ajaxSetup({},c),e=d.context||d,g=e!==d&&(e.nodeType||e instanceof f)?f(e):f.event,h=f.Deferred(),i=f._Deferred(),j=d.statusCode||{},k,l={},m={},n,o,p,q,r,s=0,t,u,v={readyState:0,setRequestHeader:function(a,b){if(!s){var c=a.toLowerCase();a=m[c]=m[c]||a,l[a]=b}return this},getAllResponseHeaders:function(){return s===2?n:null},getResponseHeader:function(a){var c;if(s===2){if(!o){o={};while(c=bD.exec(n))o[c[1].toLowerCase()]=c[2]}c=o[a.toLowerCase()]}return c===b?null:c},overrideMimeType:function(a){s||(d.mimeType=a);return this},abort:function(a){a=a||"abort",p&&p.abort(a),w(0,a);return this}};h.promise(v),v.success=v.done,v.error=v.fail,v.complete=i.done,v.statusCode=function(a){if(a){var b;if(s<2)for(b in a)j[b]=[j[b],a[b]];else b=a[v.status],v.then(b,b)}return this},d.url=((a||d.url)+"").replace(bC,"").replace(bH,bS[1]+"//"),d.dataTypes=f.trim(d.dataType||"*").toLowerCase().split(bL),d.crossDomain==null&&(r=bN.exec(d.url.toLowerCase()),d.crossDomain=!(!r||r[1]==bS[1]&&r[2]==bS[2]&&(r[3]||(r[1]==="http:"?80:443))==(bS[3]||(bS[1]==="http:"?80:443)))),d.data&&d.processData&&typeof d.data!="string"&&(d.data=f.param(d.data,d.traditional)),bW(bP,d,c,v);if(s===2)return!1;t=d.global,d.type=d.type.toUpperCase(),d.hasContent=!bG.test(d.type),t&&f.active++===0&&f.event.trigger("ajaxStart");if(!d.hasContent){d.data&&(d.url+=(bI.test(d.url)?"&":"?")+d.data,delete d.data),k=d.url;if(d.cache===!1){var x=f.now(),y=d.url.replace(bM,"$1_="+x);d.url=y+(y===d.url?(bI.test(d.url)?"&":"?")+"_="+x:"")}}(d.data&&d.hasContent&&d.contentType!==!1||c.contentType)&&v.setRequestHeader("Content-Type",d.contentType),d.ifModified&&(k=k||d.url,f.lastModified[k]&&v.setRequestHeader("If-Modified-Since",f.lastModified[k]),f.etag[k]&&v.setRequestHeader("If-None-Match",f.etag[k])),v.setRequestHeader("Accept",d.dataTypes[0]&&d.accepts[d.dataTypes[0]]?d.accepts[d.dataTypes[0]]+(d.dataTypes[0]!=="*"?", "+bT+"; q=0.01":""):d.accepts["*"]);for(u in d.headers)v.setRequestHeader(u,d.headers[u]);if(d.beforeSend&&(d.beforeSend.call(e,v,d)===!1||s===2)){v.abort();return!1}for(u in{success:1,error:1,complete:1})v[u](d[u]);p=bW(bQ,d,c,v);if(!p)w(-1,"No Transport");else{v.readyState=1,t&&g.trigger("ajaxSend",[v,d]),d.async&&d.timeout>0&&(q=setTimeout(function(){v.abort("timeout")},d.timeout));try{s=1,p.send(l,w)}catch(z){s<2?w(-1,z):f.error(z)}}return v},param:function(a,c){var d=[],e=function(a,b){b=f.isFunction(b)?b():b,d[d.length]=encodeURIComponent(a)+"="+encodeURIComponent(b)};c===b&&(c=f.ajaxSettings.traditional);if(f.isArray(a)||a.jquery&&!f.isPlainObject(a))f.each(a,function(){e(this.name,this.value)});else for(var g in a)bY(g,a[g],c,e);return d.join("&").replace(bz,"+")}}),f.extend({active:0,lastModified:{},etag:{}});var b_=f.now(),ca=/(\=)\?(&|$)|\?\?/i;f.ajaxSetup({jsonp:"callback",jsonpCallback:function(){return f.expando+"_"+b_++}}),f.ajaxPrefilter("json jsonp",function(b,c,d){var e=b.contentType==="application/x-www-form-urlencoded"&&typeof b.data=="string";if(b.dataTypes[0]==="jsonp"||b.jsonp!==!1&&(ca.test(b.url)||e&&ca.test(b.data))){var g,h=b.jsonpCallback=f.isFunction(b.jsonpCallback)?b.jsonpCallback():b.jsonpCallback,i=a[h],j=b.url,k=b.data,l="$1"+h+"$2";b.jsonp!==!1&&(j=j.replace(ca,l),b.url===j&&(e&&(k=k.replace(ca,l)),b.data===k&&(j+=(/\?/.test(j)?"&":"?")+b.jsonp+"="+h))),b.url=j,b.data=k,a[h]=function(a){g=[a]},d.always(function(){a[h]=i,g&&f.isFunction(i)&&a[h](g[0])}),b.converters["script json"]=function(){g||f.error(h+" was not called");return g[0]},b.dataTypes[0]="json";return"script"}}),f.ajaxSetup({accepts:{script:"text/javascript, application/javascript, application/ecmascript, application/x-ecmascript"},contents:{script:/javascript|ecmascript/},converters:{"text script":function(a){f.globalEval(a);return a}}}),f.ajaxPrefilter("script",function(a){a.cache===b&&(a.cache=!1),a.crossDomain&&(a.type="GET",a.global=!1)}),f.ajaxTransport("script",function(a){if(a.crossDomain){var d,e=c.head||c.getElementsByTagName("head")[0]||c.documentElement;return{send:function(f,g){d=c.createElement("script"),d.async="async",a.scriptCharset&&(d.charset=a.scriptCharset),d.src=a.url,d.onload=d.onreadystatechange=function(a,c){if(c||!d.readyState||/loaded|complete/.test(d.readyState))d.onload=d.onreadystatechange=null,e&&d.parentNode&&e.removeChild(d),d=b,c||g(200,"success")},e.insertBefore(d,e.firstChild)},abort:function(){d&&d.onload(0,1)}}}});var cb=a.ActiveXObject?function(){for(var a in cd)cd[a](0,1)}:!1,cc=0,cd;f.ajaxSettings.xhr=a.ActiveXObject?function(){return!this.isLocal&&ce()||cf()}:ce,function(a){f.extend(f.support,{ajax:!!a,cors:!!a&&"withCredentials"in a})}(f.ajaxSettings.xhr()),f.support.ajax&&f.ajaxTransport(function(c){if(!c.crossDomain||f.support.cors){var d;return{send:function(e,g){var h=c.xhr(),i,j;c.username?h.open(c.type,c.url,c.async,c.username,c.password):h.open(c.type,c.url,c.async);if(c.xhrFields)for(j in c.xhrFields)h[j]=c.xhrFields[j];c.mimeType&&h.overrideMimeType&&h.overrideMimeType(c.mimeType),!c.crossDomain&&!e["X-Requested-With"]&&(e["X-Requested-With"]="XMLHttpRequest");try{for(j in e)h.setRequestHeader(j,e[j])}catch(k){}h.send(c.hasContent&&c.data||null),d=function(a,e){var j,k,l,m,n;try{if(d&&(e||h.readyState===4)){d=b,i&&(h.onreadystatechange=f.noop,cb&&delete cd[i]);if(e)h.readyState!==4&&h.abort();else{j=h.status,l=h.getAllResponseHeaders(),m={},n=h.responseXML,n&&n.documentElement&&(m.xml=n),m.text=h.responseText;try{k=h.statusText}catch(o){k=""}!j&&c.isLocal&&!c.crossDomain?j=m.text?200:404:j===1223&&(j=204)}}}catch(p){e||g(-1,p)}m&&g(j,k,m,l)},!c.async||h.readyState===4?d():(i=++cc,cb&&(cd||(cd={},f(a).unload(cb)),cd[i]=d),h.onreadystatechange=d)},abort:function(){d&&d(0,1)}}}});var cg={},ch,ci,cj=/^(?:toggle|show|hide)$/,ck=/^([+\-]=)?([\d+.\-]+)([a-z%]*)$/i,cl,cm=[["height","marginTop","marginBottom","paddingTop","paddingBottom"],["width","marginLeft","marginRight","paddingLeft","paddingRight"],["opacity"]],cn;f.fn.extend({show:function(a,b,c){var d,e;if(a||a===0)return this.animate(cq("show",3),a,b,c);for(var g=0,h=this.length;g<h;g++)d=this[g],d.style&&(e=d.style.display,!f._data(d,"olddisplay")&&e==="none"&&(e=d.style.display=""),e===""&&f.css(d,"display")==="none"&&f._data(d,"olddisplay",cr(d.nodeName)));for(g=0;g<h;g++){d=this[g];if(d.style){e=d.style.display;if(e===""||e==="none")d.style.display=f._data(d,"olddisplay")||""}}return this},hide:function(a,b,c){if(a||a===0)return this.animate(cq("hide",3),a,b,c);for(var d=0,e=this.length;d<e;d++)if(this[d].style){var g=f.css(this[d],"display");g!=="none"&&!f._data(this[d],"olddisplay")&&f._data(this[d],"olddisplay",g)}for(d=0;d<e;d++)this[d].style&&(this[d].style.display="none");return this},_toggle:f.fn.toggle,toggle:function(a,b,c){var d=typeof a=="boolean";f.isFunction(a)&&f.isFunction(b)?this._toggle.apply(this,arguments):a==null||d?this.each(function(){var b=d?a:f(this).is(":hidden");f(this)[b?"show":"hide"]()}):this.animate(cq("toggle",3),a,b,c);return this},fadeTo:function(a,b,c,d){return this.filter(":hidden").css("opacity",0).show().end().animate({opacity:b},a,c,d)},animate:function(a,b,c,d){var e=f.speed(b,c,d);if(f.isEmptyObject(a))return this.each(e.complete,[!1]);a=f.extend({},a);return this[e.queue===!1?"each":"queue"](function(){e.queue===!1&&f._mark(this);var b=f.extend({},e),c=this.nodeType===1,d=c&&f(this).is(":hidden"),g,h,i,j,k,l,m,n,o;b.animatedProperties={};for(i in a){g=f.camelCase(i),i!==g&&(a[g]=a[i],delete a[i]),h=a[g],f.isArray(h)?(b.animatedProperties[g]=h[1],h=a[g]=h[0]):b.animatedProperties[g]=b.specialEasing&&b.specialEasing[g]||b.easing||"swing";if(h==="hide"&&d||h==="show"&&!d)return b.complete.call(this);c&&(g==="height"||g==="width")&&(b.overflow=[this.style.overflow,this.style.overflowX,this.style.overflowY],f.css(this,"display")==="inline"&&f.css(this,"float")==="none"&&(f.support.inlineBlockNeedsLayout?(j=cr(this.nodeName),j==="inline"?this.style.display="inline-block":(this.style.display="inline",this.style.zoom=1)):this.style.display="inline-block"))}b.overflow!=null&&(this.style.overflow="hidden");for(i in a)k=new f.fx(this,b,i),h=a[i],cj.test(h)?k[h==="toggle"?d?"show":"hide":h]():(l=ck.exec(h),m=k.cur(),l?(n=parseFloat(l[2]),o=l[3]||(f.cssNumber[i]?"":"px"),o!=="px"&&(f.style(this,i,(n||1)+o),m=(n||1)/k.cur()*m,f.style(this,i,m+o)),l[1]&&(n=(l[1]==="-="?-1:1)*n+m),k.custom(m,n,o)):k.custom(m,h,""));return!0})},stop:function(a,b){a&&this.queue([]),this.each(function(){var a=f.timers,c=a.length;b||f._unmark(!0,this);while(c--)a[c].elem===this&&(b&&a[c](!0),a.splice(c,1))}),b||this.dequeue();return this}}),f.each({slideDown:cq("show",1),slideUp:cq("hide",1),slideToggle:cq("toggle",1),fadeIn:{opacity:"show"},fadeOut:{opacity:"hide"},fadeToggle:{opacity:"toggle"}},function(a,b){f.fn[a]=function(a,c,d){return this.animate(b,a,c,d)}}),f.extend({speed:function(a,b,c){var d=a&&typeof a=="object"?f.extend({},a):{complete:c||!c&&b||f.isFunction(a)&&a,duration:a,easing:c&&b||b&&!f.isFunction(b)&&b};d.duration=f.fx.off?0:typeof d.duration=="number"?d.duration:d.duration in f.fx.speeds?f.fx.speeds[d.duration]:f.fx.speeds._default,d.old=d.complete,d.complete=function(a){f.isFunction(d.old)&&d.old.call(this),d.queue!==!1?f.dequeue(this):a!==!1&&f._unmark(this)};return d},easing:{linear:function(a,b,c,d){return c+d*a},swing:function(a,b,c,d){return(-Math.cos(a*Math.PI)/2+.5)*d+c}},timers:[],fx:function(a,b,c){this.options=b,this.elem=a,this.prop=c,b.orig=b.orig||{}}}),f.fx.prototype={update:function(){this.options.step&&this.options.step.call(this.elem,this.now,this),(f.fx.step[this.prop]||f.fx.step._default)(this)},cur:function(){if(this.elem[this.prop]!=null&&(!this.elem.style||this.elem.style[this.prop]==null))return this.elem[this.prop];var a,b=f.css(this.elem,this.prop);return isNaN(a=parseFloat(b))?!b||b==="auto"?0:b:a},custom:function(a,b,c){function g(a){return d.step(a)}var d=this,e=f.fx;this.startTime=cn||co(),this.start=a,this.end=b,this.unit=c||this.unit||(f.cssNumber[this.prop]?"":"px"),this.now=this.start,this.pos=this.state=0,g.elem=this.elem,g()&&f.timers.push(g)&&!cl&&(cl=setInterval(e.tick,e.interval))},show:function(){this.options.orig[this.prop]=f.style(this.elem,this.prop),this.options.show=!0,this.custom(this.prop==="width"||this.prop==="height"?1:0,this.cur()),f(this.elem).show()},hide:function(){this.options.orig[this.prop]=f.style(this.elem,this.prop),this.options.hide=!0,this.custom(this.cur(),0)},step:function(a){var b=cn||co(),c=!0,d=this.elem,e=this.options,g,h;if(a||b>=e.duration+this.startTime){this.now=this.end,this.pos=this.state=1,this.update(),e.animatedProperties[this.prop]=!0;for(g in e.animatedProperties)e.animatedProperties[g]!==!0&&(c=!1);if(c){e.overflow!=null&&!f.support.shrinkWrapBlocks&&f.each(["","X","Y"],function(a,b){d.style["overflow"+b]=e.overflow[a]}),e.hide&&f(d).hide();if(e.hide||e.show)for(var i in e.animatedProperties)f.style(d,i,e.orig[i]);e.complete.call(d)}return!1}e.duration==Infinity?this.now=b:(h=b-this.startTime,this.state=h/e.duration,this.pos=f.easing[e.animatedProperties[this.prop]](this.state,h,0,1,e.duration),this.now=this.start+(this.end-this.start)*this.pos),this.update();return!0}},f.extend(f.fx,{tick:function(){for(var a=f.timers,b=0;b<a.length;++b)a[b]()||a.splice(b--,1);a.length||f.fx.stop()},interval:13,stop:function(){clearInterval(cl),cl=null},speeds:{slow:600,fast:200,_default:400},step:{opacity:function(a){f.style(a.elem,"opacity",a.now)},_default:function(a){a.elem.style&&a.elem.style[a.prop]!=null?a.elem.style[a.prop]=(a.prop==="width"||a.prop==="height"?Math.max(0,a.now):a.now)+a.unit:a.elem[a.prop]=a.now}}}),f.expr&&f.expr.filters&&(f.expr.filters.animated=function(a){return f.grep(f.timers,function(b){return a===b.elem}).length});var cs=/^t(?:able|d|h)$/i,ct=/^(?:body|html)$/i;"getBoundingClientRect"in c.documentElement?f.fn.offset=function(a){var b=this[0],c;if(a)return this.each(function(b){f.offset.setOffset(this,a,b)});if(!b||!b.ownerDocument)return null;if(b===b.ownerDocument.body)return f.offset.bodyOffset(b);try{c=b.getBoundingClientRect()}catch(d){}var e=b.ownerDocument,g=e.documentElement;if(!c||!f.contains(g,b))return c?{top:c.top,left:c.left}:{top:0,left:0};var h=e.body,i=cu(e),j=g.clientTop||h.clientTop||0,k=g.clientLeft||h.clientLeft||0,l=i.pageYOffset||f.support.boxModel&&g.scrollTop||h.scrollTop,m=i.pageXOffset||f.support.boxModel&&g.scrollLeft||h.scrollLeft,n=c.top+l-j,o=c.left+m-k;return{top:n,left:o}}:f.fn.offset=function(a){var b=this[0];if(a)return this.each(function(b){f.offset.setOffset(this,a,b)});if(!b||!b.ownerDocument)return null;if(b===b.ownerDocument.body)return f.offset.bodyOffset(b);f.offset.initialize();var c,d=b.offsetParent,e=b,g=b.ownerDocument,h=g.documentElement,i=g.body,j=g.defaultView,k=j?j.getComputedStyle(b,null):b.currentStyle,l=b.offsetTop,m=b.offsetLeft;while((b=b.parentNode)&&b!==i&&b!==h){if(f.offset.supportsFixedPosition&&k.position==="fixed")break;c=j?j.getComputedStyle(b,null):b.currentStyle,l-=b.scrollTop,m-=b.scrollLeft,b===d&&(l+=b.offsetTop,m+=b.offsetLeft,f.offset.doesNotAddBorder&&(!f.offset.doesAddBorderForTableAndCells||!cs.test(b.nodeName))&&(l+=parseFloat(c.borderTopWidth)||0,m+=parseFloat(c.borderLeftWidth)||0),e=d,d=b.offsetParent),f.offset.subtractsBorderForOverflowNotVisible&&c.overflow!=="visible"&&(l+=parseFloat(c.borderTopWidth)||0,m+=parseFloat(c.borderLeftWidth)||0),k=c}if(k.position==="relative"||k.position==="static")l+=i.offsetTop,m+=i.offsetLeft;f.offset.supportsFixedPosition&&k.position==="fixed"&&(l+=Math.max(h.scrollTop,i.scrollTop),m+=Math.max(h.scrollLeft,i.scrollLeft));return{top:l,left:m}},f.offset={initialize:function(){var a=c.body,b=c.createElement("div"),d,e,g,h,i=parseFloat(f.css(a,"marginTop"))||0,j="<div style='position:absolute;top:0;left:0;margin:0;border:5px solid #000;padding:0;width:1px;height:1px;'><div></div></div><table style='position:absolute;top:0;left:0;margin:0;border:5px solid #000;padding:0;width:1px;height:1px;' cellpadding='0' cellspacing='0'><tr><td></td></tr></table>";f.extend(b.style,{position:"absolute",top:0,left:0,margin:0,border:0,width:"1px",height:"1px",visibility:"hidden"}),b.innerHTML=j,a.insertBefore(b,a.firstChild),d=b.firstChild,e=d.firstChild,h=d.nextSibling.firstChild.firstChild,this.doesNotAddBorder=e.offsetTop!==5,this.doesAddBorderForTableAndCells=h.offsetTop===5,e.style.position="fixed",e.style.top="20px",this.supportsFixedPosition=e.offsetTop===20||e.offsetTop===15,e.style.position=e.style.top="",d.style.overflow="hidden",d.style.position="relative",this.subtractsBorderForOverflowNotVisible=e.offsetTop===-5,this.doesNotIncludeMarginInBodyOffset=a.offsetTop!==i,a.removeChild(b),f.offset.initialize=f.noop},bodyOffset:function(a){var b=a.offsetTop,c=a.offsetLeft;f.offset.initialize(),f.offset.doesNotIncludeMarginInBodyOffset&&(b+=parseFloat(f.css(a,"marginTop"))||0,c+=parseFloat(f.css(a,"marginLeft"))||0);return{top:b,left:c}},setOffset:function(a,b,c){var d=f.css(a,"position");d==="static"&&(a.style.position="relative");var e=f(a),g=e.offset(),h=f.css(a,"top"),i=f.css(a,"left"),j=(d==="absolute"||d==="fixed")&&f.inArray("auto",[h,i])>-1,k={},l={},m,n;j?(l=e.position(),m=l.top,n=l.left):(m=parseFloat(h)||0,n=parseFloat(i)||0),f.isFunction(b)&&(b=b.call(a,c,g)),b.top!=null&&(k.top=b.top-g.top+m),b.left!=null&&(k.left=b.left-g.left+n),"using"in b?b.using.call(a,k):e.css(k)}},f.fn.extend({position:function(){if(!this[0])return null;var a=this[0],b=this.offsetParent(),c=this.offset(),d=ct.test(b[0].nodeName)?{top:0,left:0}:b.offset();c.top-=parseFloat(f.css(a,"marginTop"))||0,c.left-=parseFloat(f.css(a,"marginLeft"))||0,d.top+=parseFloat(f.css(b[0],"borderTopWidth"))||0,d.left+=parseFloat(f.css(b[0],"borderLeftWidth"))||0;return{top:c.top-d.top,left:c.left-d.left}},offsetParent:function(){return this.map(function(){var a=this.offsetParent||c.body;while(a&&!ct.test(a.nodeName)&&f.css(a,"position")==="static")a=a.offsetParent;return a})}}),f.each(["Left","Top"],function(a,c){var d="scroll"+c;f.fn[d]=function(c){var e,g;if(c===b){e=this[0];if(!e)return null;g=cu(e);return g?"pageXOffset"in g?g[a?"pageYOffset":"pageXOffset"]:f.support.boxModel&&g.document.documentElement[d]||g.document.body[d]:e[d]}return this.each(function(){g=cu(this),g?g.scrollTo(a?f(g).scrollLeft():c,a?c:f(g).scrollTop()):this[d]=c})}}),f.each(["Height","Width"],function(a,c){var d=c.toLowerCase();f.fn["inner"+c]=function(){var a=this[0];return a&&a.style?parseFloat(f.css(a,d,"padding")):null},f.fn["outer"+c]=function(a){var b=this[0];return b&&b.style?parseFloat(f.css(b,d,a?"margin":"border")):null},f.fn[d]=function(a){var e=this[0];if(!e)return a==null?null:this;if(f.isFunction(a))return this.each(function(b){var c=f(this);c[d](a.call(this,b,c[d]()))});if(f.isWindow(e)){var g=e.document.documentElement["client"+c],h=e.document.body;return e.document.compatMode==="CSS1Compat"&&g||h&&h["client"+c]||g}if(e.nodeType===9)return Math.max(e.documentElement["client"+c],e.body["scroll"+c],e.documentElement["scroll"+c],e.body["offset"+c],e.documentElement["offset"+c]);if(a===b){var i=f.css(e,d),j=parseFloat(i);return f.isNaN(j)?i:j}return this.css(d,typeof a=="string"?a:a+"px")}}),a.jQuery=a.$=f})(window);
− html/jquery.flot.min.js
@@ -1,82 +0,0 @@-/* Javascript plotting library for jQuery, v. 0.7.- *- * Released under the MIT license by IOLA, December 2007.- *- */-(function(b){b.color={};b.color.make=function(d,e,g,f){var c={};c.r=d||0;c.g=e||0;c.b=g||0;c.a=f!=null?f:1;c.add=function(h,j){for(var k=0;k<h.length;++k){c[h.charAt(k)]+=j}return c.normalize()};c.scale=function(h,j){for(var k=0;k<h.length;++k){c[h.charAt(k)]*=j}return c.normalize()};c.toString=function(){if(c.a>=1){return"rgb("+[c.r,c.g,c.b].join(",")+")"}else{return"rgba("+[c.r,c.g,c.b,c.a].join(",")+")"}};c.normalize=function(){function h(k,j,l){return j<k?k:(j>l?l:j)}c.r=h(0,parseInt(c.r),255);c.g=h(0,parseInt(c.g),255);c.b=h(0,parseInt(c.b),255);c.a=h(0,c.a,1);return c};c.clone=function(){return b.color.make(c.r,c.b,c.g,c.a)};return c.normalize()};b.color.extract=function(d,e){var c;do{c=d.css(e).toLowerCase();if(c!=""&&c!="transparent"){break}d=d.parent()}while(!b.nodeName(d.get(0),"body"));if(c=="rgba(0, 0, 0, 0)"){c="transparent"}return b.color.parse(c)};b.color.parse=function(c){var d,f=b.color.make;if(d=/rgb\(\s*([0-9]{1,3})\s*,\s*([0-9]{1,3})\s*,\s*([0-9]{1,3})\s*\)/.exec(c)){return f(parseInt(d[1],10),parseInt(d[2],10),parseInt(d[3],10))}if(d=/rgba\(\s*([0-9]{1,3})\s*,\s*([0-9]{1,3})\s*,\s*([0-9]{1,3})\s*,\s*([0-9]+(?:\.[0-9]+)?)\s*\)/.exec(c)){return f(parseInt(d[1],10),parseInt(d[2],10),parseInt(d[3],10),parseFloat(d[4]))}if(d=/rgb\(\s*([0-9]+(?:\.[0-9]+)?)\%\s*,\s*([0-9]+(?:\.[0-9]+)?)\%\s*,\s*([0-9]+(?:\.[0-9]+)?)\%\s*\)/.exec(c)){return f(parseFloat(d[1])*2.55,parseFloat(d[2])*2.55,parseFloat(d[3])*2.55)}if(d=/rgba\(\s*([0-9]+(?:\.[0-9]+)?)\%\s*,\s*([0-9]+(?:\.[0-9]+)?)\%\s*,\s*([0-9]+(?:\.[0-9]+)?)\%\s*,\s*([0-9]+(?:\.[0-9]+)?)\s*\)/.exec(c)){return f(parseFloat(d[1])*2.55,parseFloat(d[2])*2.55,parseFloat(d[3])*2.55,parseFloat(d[4]))}if(d=/#([a-fA-F0-9]{2})([a-fA-F0-9]{2})([a-fA-F0-9]{2})/.exec(c)){return f(parseInt(d[1],16),parseInt(d[2],16),parseInt(d[3],16))}if(d=/#([a-fA-F0-9])([a-fA-F0-9])([a-fA-F0-9])/.exec(c)){return f(parseInt(d[1]+d[1],16),parseInt(d[2]+d[2],16),parseInt(d[3]+d[3],16))}var e=b.trim(c).toLowerCase();if(e=="transparent"){return f(255,255,255,0)}else{d=a[e]||[0,0,0];return f(d[0],d[1],d[2])}};var a={aqua:[0,255,255],azure:[240,255,255],beige:[245,245,220],black:[0,0,0],blue:[0,0,255],brown:[165,42,42],cyan:[0,255,255],darkblue:[0,0,139],darkcyan:[0,139,139],darkgrey:[169,169,169],darkgreen:[0,100,0],darkkhaki:[189,183,107],darkmagenta:[139,0,139],darkolivegreen:[85,107,47],darkorange:[255,140,0],darkorchid:[153,50,204],darkred:[139,0,0],darksalmon:[233,150,122],darkviolet:[148,0,211],fuchsia:[255,0,255],gold:[255,215,0],green:[0,128,0],indigo:[75,0,130],khaki:[240,230,140],lightblue:[173,216,230],lightcyan:[224,255,255],lightgreen:[144,238,144],lightgrey:[211,211,211],lightpink:[255,182,193],lightyellow:[255,255,224],lime:[0,255,0],magenta:[255,0,255],maroon:[128,0,0],navy:[0,0,128],olive:[128,128,0],orange:[255,165,0],pink:[255,192,203],purple:[128,0,128],violet:[128,0,128],red:[255,0,0],silver:[192,192,192],white:[255,255,255],yellow:[255,255,0]}})(jQuery);(function(c){function b(av,ai,J,af){var Q=[],O={colors:["#edc240","#afd8f8","#cb4b4b","#4da74d","#9440ed"],legend:{show:true,noColumns:1,labelFormatter:null,labelBoxBorderColor:"#ccc",container:null,position:"ne",margin:5,backgroundColor:null,backgroundOpacity:0.85},xaxis:{show:null,position:"bottom",mode:null,color:null,tickColor:null,transform:null,inverseTransform:null,min:null,max:null,autoscaleMargin:null,ticks:null,tickFormatter:null,labelWidth:null,labelHeight:null,reserveSpace:null,tickLength:null,alignTicksWithAxis:null,tickDecimals:null,tickSize:null,minTickSize:null,monthNames:null,timeformat:null,twelveHourClock:false},yaxis:{autoscaleMargin:0.02,position:"left"},xaxes:[],yaxes:[],series:{points:{show:false,radius:3,lineWidth:2,fill:true,fillColor:"#ffffff",symbol:"circle"},lines:{lineWidth:2,fill:false,fillColor:null,steps:false},bars:{show:false,lineWidth:2,barWidth:1,fill:true,fillColor:null,align:"left",horizontal:false},shadowSize:3},grid:{show:true,aboveData:false,color:"#545454",backgroundColor:null,borderColor:null,tickColor:null,labelMargin:5,axisMargin:8,borderWidth:2,minBorderMargin:null,markings:null,markingsColor:"#f4f4f4",markingsLineWidth:2,clickable:false,hoverable:false,autoHighlight:true,mouseActiveRadius:10},hooks:{}},az=null,ad=null,y=null,H=null,A=null,p=[],aw=[],q={left:0,right:0,top:0,bottom:0},G=0,I=0,h=0,w=0,ak={processOptions:[],processRawData:[],processDatapoints:[],drawSeries:[],draw:[],bindEvents:[],drawOverlay:[],shutdown:[]},aq=this;aq.setData=aj;aq.setupGrid=t;aq.draw=W;aq.getPlaceholder=function(){return av};aq.getCanvas=function(){return az};aq.getPlotOffset=function(){return q};aq.width=function(){return h};aq.height=function(){return w};aq.offset=function(){var aB=y.offset();aB.left+=q.left;aB.top+=q.top;return aB};aq.getData=function(){return Q};aq.getAxes=function(){var aC={},aB;c.each(p.concat(aw),function(aD,aE){if(aE){aC[aE.direction+(aE.n!=1?aE.n:"")+"axis"]=aE}});return aC};aq.getXAxes=function(){return p};aq.getYAxes=function(){return aw};aq.c2p=C;aq.p2c=ar;aq.getOptions=function(){return O};aq.highlight=x;aq.unhighlight=T;aq.triggerRedrawOverlay=f;aq.pointOffset=function(aB){return{left:parseInt(p[aA(aB,"x")-1].p2c(+aB.x)+q.left),top:parseInt(aw[aA(aB,"y")-1].p2c(+aB.y)+q.top)}};aq.shutdown=ag;aq.resize=function(){B();g(az);g(ad)};aq.hooks=ak;F(aq);Z(J);X();aj(ai);t();W();ah();function an(aD,aB){aB=[aq].concat(aB);for(var aC=0;aC<aD.length;++aC){aD[aC].apply(this,aB)}}function F(){for(var aB=0;aB<af.length;++aB){var aC=af[aB];aC.init(aq);if(aC.options){c.extend(true,O,aC.options)}}}function Z(aC){var aB;c.extend(true,O,aC);if(O.xaxis.color==null){O.xaxis.color=O.grid.color}if(O.yaxis.color==null){O.yaxis.color=O.grid.color}if(O.xaxis.tickColor==null){O.xaxis.tickColor=O.grid.tickColor}if(O.yaxis.tickColor==null){O.yaxis.tickColor=O.grid.tickColor}if(O.grid.borderColor==null){O.grid.borderColor=O.grid.color}if(O.grid.tickColor==null){O.grid.tickColor=c.color.parse(O.grid.color).scale("a",0.22).toString()}for(aB=0;aB<Math.max(1,O.xaxes.length);++aB){O.xaxes[aB]=c.extend(true,{},O.xaxis,O.xaxes[aB])}for(aB=0;aB<Math.max(1,O.yaxes.length);++aB){O.yaxes[aB]=c.extend(true,{},O.yaxis,O.yaxes[aB])}if(O.xaxis.noTicks&&O.xaxis.ticks==null){O.xaxis.ticks=O.xaxis.noTicks}if(O.yaxis.noTicks&&O.yaxis.ticks==null){O.yaxis.ticks=O.yaxis.noTicks}if(O.x2axis){O.xaxes[1]=c.extend(true,{},O.xaxis,O.x2axis);O.xaxes[1].position="top"}if(O.y2axis){O.yaxes[1]=c.extend(true,{},O.yaxis,O.y2axis);O.yaxes[1].position="right"}if(O.grid.coloredAreas){O.grid.markings=O.grid.coloredAreas}if(O.grid.coloredAreasColor){O.grid.markingsColor=O.grid.coloredAreasColor}if(O.lines){c.extend(true,O.series.lines,O.lines)}if(O.points){c.extend(true,O.series.points,O.points)}if(O.bars){c.extend(true,O.series.bars,O.bars)}if(O.shadowSize!=null){O.series.shadowSize=O.shadowSize}for(aB=0;aB<O.xaxes.length;++aB){V(p,aB+1).options=O.xaxes[aB]}for(aB=0;aB<O.yaxes.length;++aB){V(aw,aB+1).options=O.yaxes[aB]}for(var aD in ak){if(O.hooks[aD]&&O.hooks[aD].length){ak[aD]=ak[aD].concat(O.hooks[aD])}}an(ak.processOptions,[O])}function aj(aB){Q=Y(aB);ax();z()}function Y(aE){var aC=[];for(var aB=0;aB<aE.length;++aB){var aD=c.extend(true,{},O.series);if(aE[aB].data!=null){aD.data=aE[aB].data;delete aE[aB].data;c.extend(true,aD,aE[aB]);aE[aB].data=aD.data}else{aD.data=aE[aB]}aC.push(aD)}return aC}function aA(aC,aD){var aB=aC[aD+"axis"];if(typeof aB=="object"){aB=aB.n}if(typeof aB!="number"){aB=1}return aB}function m(){return c.grep(p.concat(aw),function(aB){return aB})}function C(aE){var aC={},aB,aD;for(aB=0;aB<p.length;++aB){aD=p[aB];if(aD&&aD.used){aC["x"+aD.n]=aD.c2p(aE.left)}}for(aB=0;aB<aw.length;++aB){aD=aw[aB];if(aD&&aD.used){aC["y"+aD.n]=aD.c2p(aE.top)}}if(aC.x1!==undefined){aC.x=aC.x1}if(aC.y1!==undefined){aC.y=aC.y1}return aC}function ar(aF){var aD={},aC,aE,aB;for(aC=0;aC<p.length;++aC){aE=p[aC];if(aE&&aE.used){aB="x"+aE.n;if(aF[aB]==null&&aE.n==1){aB="x"}if(aF[aB]!=null){aD.left=aE.p2c(aF[aB]);break}}}for(aC=0;aC<aw.length;++aC){aE=aw[aC];if(aE&&aE.used){aB="y"+aE.n;if(aF[aB]==null&&aE.n==1){aB="y"}if(aF[aB]!=null){aD.top=aE.p2c(aF[aB]);break}}}return aD}function V(aC,aB){if(!aC[aB-1]){aC[aB-1]={n:aB,direction:aC==p?"x":"y",options:c.extend(true,{},aC==p?O.xaxis:O.yaxis)}}return aC[aB-1]}function ax(){var aG;var aM=Q.length,aB=[],aE=[];for(aG=0;aG<Q.length;++aG){var aJ=Q[aG].color;if(aJ!=null){--aM;if(typeof aJ=="number"){aE.push(aJ)}else{aB.push(c.color.parse(Q[aG].color))}}}for(aG=0;aG<aE.length;++aG){aM=Math.max(aM,aE[aG]+1)}var aC=[],aF=0;aG=0;while(aC.length<aM){var aI;if(O.colors.length==aG){aI=c.color.make(100,100,100)}else{aI=c.color.parse(O.colors[aG])}var aD=aF%2==1?-1:1;aI.scale("rgb",1+aD*Math.ceil(aF/2)*0.2);aC.push(aI);++aG;if(aG>=O.colors.length){aG=0;++aF}}var aH=0,aN;for(aG=0;aG<Q.length;++aG){aN=Q[aG];if(aN.color==null){aN.color=aC[aH].toString();++aH}else{if(typeof aN.color=="number"){aN.color=aC[aN.color].toString()}}if(aN.lines.show==null){var aL,aK=true;for(aL in aN){if(aN[aL]&&aN[aL].show){aK=false;break}}if(aK){aN.lines.show=true}}aN.xaxis=V(p,aA(aN,"x"));aN.yaxis=V(aw,aA(aN,"y"))}}function z(){var aO=Number.POSITIVE_INFINITY,aI=Number.NEGATIVE_INFINITY,aB=Number.MAX_VALUE,aU,aS,aR,aN,aD,aJ,aT,aP,aH,aG,aC,a0,aX,aL;function aF(a3,a2,a1){if(a2<a3.datamin&&a2!=-aB){a3.datamin=a2}if(a1>a3.datamax&&a1!=aB){a3.datamax=a1}}c.each(m(),function(a1,a2){a2.datamin=aO;a2.datamax=aI;a2.used=false});for(aU=0;aU<Q.length;++aU){aJ=Q[aU];aJ.datapoints={points:[]};an(ak.processRawData,[aJ,aJ.data,aJ.datapoints])}for(aU=0;aU<Q.length;++aU){aJ=Q[aU];var aZ=aJ.data,aW=aJ.datapoints.format;if(!aW){aW=[];aW.push({x:true,number:true,required:true});aW.push({y:true,number:true,required:true});if(aJ.bars.show||(aJ.lines.show&&aJ.lines.fill)){aW.push({y:true,number:true,required:false,defaultValue:0});if(aJ.bars.horizontal){delete aW[aW.length-1].y;aW[aW.length-1].x=true}}aJ.datapoints.format=aW}if(aJ.datapoints.pointsize!=null){continue}aJ.datapoints.pointsize=aW.length;aP=aJ.datapoints.pointsize;aT=aJ.datapoints.points;insertSteps=aJ.lines.show&&aJ.lines.steps;aJ.xaxis.used=aJ.yaxis.used=true;for(aS=aR=0;aS<aZ.length;++aS,aR+=aP){aL=aZ[aS];var aE=aL==null;if(!aE){for(aN=0;aN<aP;++aN){a0=aL[aN];aX=aW[aN];if(aX){if(aX.number&&a0!=null){a0=+a0;if(isNaN(a0)){a0=null}else{if(a0==Infinity){a0=aB}else{if(a0==-Infinity){a0=-aB}}}}if(a0==null){if(aX.required){aE=true}if(aX.defaultValue!=null){a0=aX.defaultValue}}}aT[aR+aN]=a0}}if(aE){for(aN=0;aN<aP;++aN){a0=aT[aR+aN];if(a0!=null){aX=aW[aN];if(aX.x){aF(aJ.xaxis,a0,a0)}if(aX.y){aF(aJ.yaxis,a0,a0)}}aT[aR+aN]=null}}else{if(insertSteps&&aR>0&&aT[aR-aP]!=null&&aT[aR-aP]!=aT[aR]&&aT[aR-aP+1]!=aT[aR+1]){for(aN=0;aN<aP;++aN){aT[aR+aP+aN]=aT[aR+aN]}aT[aR+1]=aT[aR-aP+1];aR+=aP}}}}for(aU=0;aU<Q.length;++aU){aJ=Q[aU];an(ak.processDatapoints,[aJ,aJ.datapoints])}for(aU=0;aU<Q.length;++aU){aJ=Q[aU];aT=aJ.datapoints.points,aP=aJ.datapoints.pointsize;var aK=aO,aQ=aO,aM=aI,aV=aI;for(aS=0;aS<aT.length;aS+=aP){if(aT[aS]==null){continue}for(aN=0;aN<aP;++aN){a0=aT[aS+aN];aX=aW[aN];if(!aX||a0==aB||a0==-aB){continue}if(aX.x){if(a0<aK){aK=a0}if(a0>aM){aM=a0}}if(aX.y){if(a0<aQ){aQ=a0}if(a0>aV){aV=a0}}}}if(aJ.bars.show){var aY=aJ.bars.align=="left"?0:-aJ.bars.barWidth/2;if(aJ.bars.horizontal){aQ+=aY;aV+=aY+aJ.bars.barWidth}else{aK+=aY;aM+=aY+aJ.bars.barWidth}}aF(aJ.xaxis,aK,aM);aF(aJ.yaxis,aQ,aV)}c.each(m(),function(a1,a2){if(a2.datamin==aO){a2.datamin=null}if(a2.datamax==aI){a2.datamax=null}})}function j(aB,aC){var aD=document.createElement("canvas");aD.className=aC;aD.width=G;aD.height=I;if(!aB){c(aD).css({position:"absolute",left:0,top:0})}c(aD).appendTo(av);if(!aD.getContext){aD=window.G_vmlCanvasManager.initElement(aD)}aD.getContext("2d").save();return aD}function B(){G=av.width();I=av.height();if(G<=0||I<=0){throw"Invalid dimensions for plot, width = "+G+", height = "+I}}function g(aC){if(aC.width!=G){aC.width=G}if(aC.height!=I){aC.height=I}var aB=aC.getContext("2d");aB.restore();aB.save()}function X(){var aC,aB=av.children("canvas.base"),aD=av.children("canvas.overlay");if(aB.length==0||aD==0){av.html("");av.css({padding:0});if(av.css("position")=="static"){av.css("position","relative")}B();az=j(true,"base");ad=j(false,"overlay");aC=false}else{az=aB.get(0);ad=aD.get(0);aC=true}H=az.getContext("2d");A=ad.getContext("2d");y=c([ad,az]);if(aC){av.data("plot").shutdown();aq.resize();A.clearRect(0,0,G,I);y.unbind();av.children().not([az,ad]).remove()}av.data("plot",aq)}function ah(){if(O.grid.hoverable){y.mousemove(aa);y.mouseleave(l)}if(O.grid.clickable){y.click(R)}an(ak.bindEvents,[y])}function ag(){if(M){clearTimeout(M)}y.unbind("mousemove",aa);y.unbind("mouseleave",l);y.unbind("click",R);an(ak.shutdown,[y])}function r(aG){function aC(aH){return aH}var aF,aB,aD=aG.options.transform||aC,aE=aG.options.inverseTransform;if(aG.direction=="x"){aF=aG.scale=h/Math.abs(aD(aG.max)-aD(aG.min));aB=Math.min(aD(aG.max),aD(aG.min))}else{aF=aG.scale=w/Math.abs(aD(aG.max)-aD(aG.min));aF=-aF;aB=Math.max(aD(aG.max),aD(aG.min))}if(aD==aC){aG.p2c=function(aH){return(aH-aB)*aF}}else{aG.p2c=function(aH){return(aD(aH)-aB)*aF}}if(!aE){aG.c2p=function(aH){return aB+aH/aF}}else{aG.c2p=function(aH){return aE(aB+aH/aF)}}}function L(aD){var aB=aD.options,aF,aJ=aD.ticks||[],aI=[],aE,aK=aB.labelWidth,aG=aB.labelHeight,aC;function aH(aM,aL){return c('<div style="position:absolute;top:-10000px;'+aL+'font-size:smaller"><div class="'+aD.direction+"Axis "+aD.direction+aD.n+'Axis">'+aM.join("")+"</div></div>").appendTo(av)}if(aD.direction=="x"){if(aK==null){aK=Math.floor(G/(aJ.length>0?aJ.length:1))}if(aG==null){aI=[];for(aF=0;aF<aJ.length;++aF){aE=aJ[aF].label;if(aE){aI.push('<div class="tickLabel" style="float:left;width:'+aK+'px">'+aE+"</div>")}}if(aI.length>0){aI.push('<div style="clear:left"></div>');aC=aH(aI,"width:10000px;");aG=aC.height();aC.remove()}}}else{if(aK==null||aG==null){for(aF=0;aF<aJ.length;++aF){aE=aJ[aF].label;if(aE){aI.push('<div class="tickLabel">'+aE+"</div>")}}if(aI.length>0){aC=aH(aI,"");if(aK==null){aK=aC.children().width()}if(aG==null){aG=aC.find("div.tickLabel").height()}aC.remove()}}}if(aK==null){aK=0}if(aG==null){aG=0}aD.labelWidth=aK;aD.labelHeight=aG}function au(aD){var aC=aD.labelWidth,aL=aD.labelHeight,aH=aD.options.position,aF=aD.options.tickLength,aG=O.grid.axisMargin,aJ=O.grid.labelMargin,aK=aD.direction=="x"?p:aw,aE;var aB=c.grep(aK,function(aN){return aN&&aN.options.position==aH&&aN.reserveSpace});if(c.inArray(aD,aB)==aB.length-1){aG=0}if(aF==null){aF="full"}var aI=c.grep(aK,function(aN){return aN&&aN.reserveSpace});var aM=c.inArray(aD,aI)==0;if(!aM&&aF=="full"){aF=5}if(!isNaN(+aF)){aJ+=+aF}if(aD.direction=="x"){aL+=aJ;if(aH=="bottom"){q.bottom+=aL+aG;aD.box={top:I-q.bottom,height:aL}}else{aD.box={top:q.top+aG,height:aL};q.top+=aL+aG}}else{aC+=aJ;if(aH=="left"){aD.box={left:q.left+aG,width:aC};q.left+=aC+aG}else{q.right+=aC+aG;aD.box={left:G-q.right,width:aC}}}aD.position=aH;aD.tickLength=aF;aD.box.padding=aJ;aD.innermost=aM}function U(aB){if(aB.direction=="x"){aB.box.left=q.left;aB.box.width=h}else{aB.box.top=q.top;aB.box.height=w}}function t(){var aC,aE=m();c.each(aE,function(aF,aG){aG.show=aG.options.show;if(aG.show==null){aG.show=aG.used}aG.reserveSpace=aG.show||aG.options.reserveSpace;n(aG)});allocatedAxes=c.grep(aE,function(aF){return aF.reserveSpace});q.left=q.right=q.top=q.bottom=0;if(O.grid.show){c.each(allocatedAxes,function(aF,aG){S(aG);P(aG);ap(aG,aG.ticks);L(aG)});for(aC=allocatedAxes.length-1;aC>=0;--aC){au(allocatedAxes[aC])}var aD=O.grid.minBorderMargin;if(aD==null){aD=0;for(aC=0;aC<Q.length;++aC){aD=Math.max(aD,Q[aC].points.radius+Q[aC].points.lineWidth/2)}}for(var aB in q){q[aB]+=O.grid.borderWidth;q[aB]=Math.max(aD,q[aB])}}h=G-q.left-q.right;w=I-q.bottom-q.top;c.each(aE,function(aF,aG){r(aG)});if(O.grid.show){c.each(allocatedAxes,function(aF,aG){U(aG)});k()}o()}function n(aE){var aF=aE.options,aD=+(aF.min!=null?aF.min:aE.datamin),aB=+(aF.max!=null?aF.max:aE.datamax),aH=aB-aD;if(aH==0){var aC=aB==0?1:0.01;if(aF.min==null){aD-=aC}if(aF.max==null||aF.min!=null){aB+=aC}}else{var aG=aF.autoscaleMargin;if(aG!=null){if(aF.min==null){aD-=aH*aG;if(aD<0&&aE.datamin!=null&&aE.datamin>=0){aD=0}}if(aF.max==null){aB+=aH*aG;if(aB>0&&aE.datamax!=null&&aE.datamax<=0){aB=0}}}}aE.min=aD;aE.max=aB}function S(aG){var aM=aG.options;var aH;if(typeof aM.ticks=="number"&&aM.ticks>0){aH=aM.ticks}else{aH=0.3*Math.sqrt(aG.direction=="x"?G:I)}var aT=(aG.max-aG.min)/aH,aO,aB,aN,aR,aS,aQ,aI;if(aM.mode=="time"){var aJ={second:1000,minute:60*1000,hour:60*60*1000,day:24*60*60*1000,month:30*24*60*60*1000,year:365.2425*24*60*60*1000};var aK=[[1,"second"],[2,"second"],[5,"second"],[10,"second"],[30,"second"],[1,"minute"],[2,"minute"],[5,"minute"],[10,"minute"],[30,"minute"],[1,"hour"],[2,"hour"],[4,"hour"],[8,"hour"],[12,"hour"],[1,"day"],[2,"day"],[3,"day"],[0.25,"month"],[0.5,"month"],[1,"month"],[2,"month"],[3,"month"],[6,"month"],[1,"year"]];var aC=0;if(aM.minTickSize!=null){if(typeof aM.tickSize=="number"){aC=aM.tickSize}else{aC=aM.minTickSize[0]*aJ[aM.minTickSize[1]]}}for(var aS=0;aS<aK.length-1;++aS){if(aT<(aK[aS][0]*aJ[aK[aS][1]]+aK[aS+1][0]*aJ[aK[aS+1][1]])/2&&aK[aS][0]*aJ[aK[aS][1]]>=aC){break}}aO=aK[aS][0];aN=aK[aS][1];if(aN=="year"){aQ=Math.pow(10,Math.floor(Math.log(aT/aJ.year)/Math.LN10));aI=(aT/aJ.year)/aQ;if(aI<1.5){aO=1}else{if(aI<3){aO=2}else{if(aI<7.5){aO=5}else{aO=10}}}aO*=aQ}aG.tickSize=aM.tickSize||[aO,aN];aB=function(aX){var a2=[],a0=aX.tickSize[0],a3=aX.tickSize[1],a1=new Date(aX.min);var aW=a0*aJ[a3];if(a3=="second"){a1.setUTCSeconds(a(a1.getUTCSeconds(),a0))}if(a3=="minute"){a1.setUTCMinutes(a(a1.getUTCMinutes(),a0))}if(a3=="hour"){a1.setUTCHours(a(a1.getUTCHours(),a0))}if(a3=="month"){a1.setUTCMonth(a(a1.getUTCMonth(),a0))}if(a3=="year"){a1.setUTCFullYear(a(a1.getUTCFullYear(),a0))}a1.setUTCMilliseconds(0);if(aW>=aJ.minute){a1.setUTCSeconds(0)}if(aW>=aJ.hour){a1.setUTCMinutes(0)}if(aW>=aJ.day){a1.setUTCHours(0)}if(aW>=aJ.day*4){a1.setUTCDate(1)}if(aW>=aJ.year){a1.setUTCMonth(0)}var a5=0,a4=Number.NaN,aY;do{aY=a4;a4=a1.getTime();a2.push(a4);if(a3=="month"){if(a0<1){a1.setUTCDate(1);var aV=a1.getTime();a1.setUTCMonth(a1.getUTCMonth()+1);var aZ=a1.getTime();a1.setTime(a4+a5*aJ.hour+(aZ-aV)*a0);a5=a1.getUTCHours();a1.setUTCHours(0)}else{a1.setUTCMonth(a1.getUTCMonth()+a0)}}else{if(a3=="year"){a1.setUTCFullYear(a1.getUTCFullYear()+a0)}else{a1.setTime(a4+aW)}}}while(a4<aX.max&&a4!=aY);return a2};aR=function(aV,aY){var a0=new Date(aV);if(aM.timeformat!=null){return c.plot.formatDate(a0,aM.timeformat,aM.monthNames)}var aW=aY.tickSize[0]*aJ[aY.tickSize[1]];var aX=aY.max-aY.min;var aZ=(aM.twelveHourClock)?" %p":"";if(aW<aJ.minute){fmt="%h:%M:%S"+aZ}else{if(aW<aJ.day){if(aX<2*aJ.day){fmt="%h:%M"+aZ}else{fmt="%b %d %h:%M"+aZ}}else{if(aW<aJ.month){fmt="%b %d"}else{if(aW<aJ.year){if(aX<aJ.year){fmt="%b"}else{fmt="%b %y"}}else{fmt="%y"}}}}return c.plot.formatDate(a0,fmt,aM.monthNames)}}else{var aU=aM.tickDecimals;var aP=-Math.floor(Math.log(aT)/Math.LN10);if(aU!=null&&aP>aU){aP=aU}aQ=Math.pow(10,-aP);aI=aT/aQ;if(aI<1.5){aO=1}else{if(aI<3){aO=2;if(aI>2.25&&(aU==null||aP+1<=aU)){aO=2.5;++aP}}else{if(aI<7.5){aO=5}else{aO=10}}}aO*=aQ;if(aM.minTickSize!=null&&aO<aM.minTickSize){aO=aM.minTickSize}aG.tickDecimals=Math.max(0,aU!=null?aU:aP);aG.tickSize=aM.tickSize||aO;aB=function(aX){var aZ=[];var a0=a(aX.min,aX.tickSize),aW=0,aV=Number.NaN,aY;do{aY=aV;aV=a0+aW*aX.tickSize;aZ.push(aV);++aW}while(aV<aX.max&&aV!=aY);return aZ};aR=function(aV,aW){return aV.toFixed(aW.tickDecimals)}}if(aM.alignTicksWithAxis!=null){var aF=(aG.direction=="x"?p:aw)[aM.alignTicksWithAxis-1];if(aF&&aF.used&&aF!=aG){var aL=aB(aG);if(aL.length>0){if(aM.min==null){aG.min=Math.min(aG.min,aL[0])}if(aM.max==null&&aL.length>1){aG.max=Math.max(aG.max,aL[aL.length-1])}}aB=function(aX){var aY=[],aV,aW;for(aW=0;aW<aF.ticks.length;++aW){aV=(aF.ticks[aW].v-aF.min)/(aF.max-aF.min);aV=aX.min+aV*(aX.max-aX.min);aY.push(aV)}return aY};if(aG.mode!="time"&&aM.tickDecimals==null){var aE=Math.max(0,-Math.floor(Math.log(aT)/Math.LN10)+1),aD=aB(aG);if(!(aD.length>1&&/\..*0$/.test((aD[1]-aD[0]).toFixed(aE)))){aG.tickDecimals=aE}}}}aG.tickGenerator=aB;if(c.isFunction(aM.tickFormatter)){aG.tickFormatter=function(aV,aW){return""+aM.tickFormatter(aV,aW)}}else{aG.tickFormatter=aR}}function P(aF){var aH=aF.options.ticks,aG=[];if(aH==null||(typeof aH=="number"&&aH>0)){aG=aF.tickGenerator(aF)}else{if(aH){if(c.isFunction(aH)){aG=aH({min:aF.min,max:aF.max})}else{aG=aH}}}var aE,aB;aF.ticks=[];for(aE=0;aE<aG.length;++aE){var aC=null;var aD=aG[aE];if(typeof aD=="object"){aB=+aD[0];if(aD.length>1){aC=aD[1]}}else{aB=+aD}if(aC==null){aC=aF.tickFormatter(aB,aF)}if(!isNaN(aB)){aF.ticks.push({v:aB,label:aC})}}}function ap(aB,aC){if(aB.options.autoscaleMargin&&aC.length>0){if(aB.options.min==null){aB.min=Math.min(aB.min,aC[0].v)}if(aB.options.max==null&&aC.length>1){aB.max=Math.max(aB.max,aC[aC.length-1].v)}}}function W(){H.clearRect(0,0,G,I);var aC=O.grid;if(aC.show&&aC.backgroundColor){N()}if(aC.show&&!aC.aboveData){ac()}for(var aB=0;aB<Q.length;++aB){an(ak.drawSeries,[H,Q[aB]]);d(Q[aB])}an(ak.draw,[H]);if(aC.show&&aC.aboveData){ac()}}function D(aB,aI){var aE,aH,aG,aD,aF=m();for(i=0;i<aF.length;++i){aE=aF[i];if(aE.direction==aI){aD=aI+aE.n+"axis";if(!aB[aD]&&aE.n==1){aD=aI+"axis"}if(aB[aD]){aH=aB[aD].from;aG=aB[aD].to;break}}}if(!aB[aD]){aE=aI=="x"?p[0]:aw[0];aH=aB[aI+"1"];aG=aB[aI+"2"]}if(aH!=null&&aG!=null&&aH>aG){var aC=aH;aH=aG;aG=aC}return{from:aH,to:aG,axis:aE}}function N(){H.save();H.translate(q.left,q.top);H.fillStyle=am(O.grid.backgroundColor,w,0,"rgba(255, 255, 255, 0)");H.fillRect(0,0,h,w);H.restore()}function ac(){var aF;H.save();H.translate(q.left,q.top);var aH=O.grid.markings;if(aH){if(c.isFunction(aH)){var aK=aq.getAxes();aK.xmin=aK.xaxis.min;aK.xmax=aK.xaxis.max;aK.ymin=aK.yaxis.min;aK.ymax=aK.yaxis.max;aH=aH(aK)}for(aF=0;aF<aH.length;++aF){var aD=aH[aF],aC=D(aD,"x"),aI=D(aD,"y");if(aC.from==null){aC.from=aC.axis.min}if(aC.to==null){aC.to=aC.axis.max}if(aI.from==null){aI.from=aI.axis.min}if(aI.to==null){aI.to=aI.axis.max}if(aC.to<aC.axis.min||aC.from>aC.axis.max||aI.to<aI.axis.min||aI.from>aI.axis.max){continue}aC.from=Math.max(aC.from,aC.axis.min);aC.to=Math.min(aC.to,aC.axis.max);aI.from=Math.max(aI.from,aI.axis.min);aI.to=Math.min(aI.to,aI.axis.max);if(aC.from==aC.to&&aI.from==aI.to){continue}aC.from=aC.axis.p2c(aC.from);aC.to=aC.axis.p2c(aC.to);aI.from=aI.axis.p2c(aI.from);aI.to=aI.axis.p2c(aI.to);if(aC.from==aC.to||aI.from==aI.to){H.beginPath();H.strokeStyle=aD.color||O.grid.markingsColor;H.lineWidth=aD.lineWidth||O.grid.markingsLineWidth;H.moveTo(aC.from,aI.from);H.lineTo(aC.to,aI.to);H.stroke()}else{H.fillStyle=aD.color||O.grid.markingsColor;H.fillRect(aC.from,aI.to,aC.to-aC.from,aI.from-aI.to)}}}var aK=m(),aM=O.grid.borderWidth;for(var aE=0;aE<aK.length;++aE){var aB=aK[aE],aG=aB.box,aQ=aB.tickLength,aN,aL,aP,aJ;if(!aB.show||aB.ticks.length==0){continue}H.strokeStyle=aB.options.tickColor||c.color.parse(aB.options.color).scale("a",0.22).toString();H.lineWidth=1;if(aB.direction=="x"){aN=0;if(aQ=="full"){aL=(aB.position=="top"?0:w)}else{aL=aG.top-q.top+(aB.position=="top"?aG.height:0)}}else{aL=0;if(aQ=="full"){aN=(aB.position=="left"?0:h)}else{aN=aG.left-q.left+(aB.position=="left"?aG.width:0)}}if(!aB.innermost){H.beginPath();aP=aJ=0;if(aB.direction=="x"){aP=h}else{aJ=w}if(H.lineWidth==1){aN=Math.floor(aN)+0.5;aL=Math.floor(aL)+0.5}H.moveTo(aN,aL);H.lineTo(aN+aP,aL+aJ);H.stroke()}H.beginPath();for(aF=0;aF<aB.ticks.length;++aF){var aO=aB.ticks[aF].v;aP=aJ=0;if(aO<aB.min||aO>aB.max||(aQ=="full"&&aM>0&&(aO==aB.min||aO==aB.max))){continue}if(aB.direction=="x"){aN=aB.p2c(aO);aJ=aQ=="full"?-w:aQ;if(aB.position=="top"){aJ=-aJ}}else{aL=aB.p2c(aO);aP=aQ=="full"?-h:aQ;if(aB.position=="left"){aP=-aP}}if(H.lineWidth==1){if(aB.direction=="x"){aN=Math.floor(aN)+0.5}else{aL=Math.floor(aL)+0.5}}H.moveTo(aN,aL);H.lineTo(aN+aP,aL+aJ)}H.stroke()}if(aM){H.lineWidth=aM;H.strokeStyle=O.grid.borderColor;H.strokeRect(-aM/2,-aM/2,h+aM,w+aM)}H.restore()}function k(){av.find(".tickLabels").remove();var aG=['<div class="tickLabels" style="font-size:smaller">'];var aJ=m();for(var aD=0;aD<aJ.length;++aD){var aC=aJ[aD],aF=aC.box;if(!aC.show){continue}aG.push('<div class="'+aC.direction+"Axis "+aC.direction+aC.n+'Axis" style="color:'+aC.options.color+'">');for(var aE=0;aE<aC.ticks.length;++aE){var aH=aC.ticks[aE];if(!aH.label||aH.v<aC.min||aH.v>aC.max){continue}var aK={},aI;if(aC.direction=="x"){aI="center";aK.left=Math.round(q.left+aC.p2c(aH.v)-aC.labelWidth/2);if(aC.position=="bottom"){aK.top=aF.top+aF.padding}else{aK.bottom=I-(aF.top+aF.height-aF.padding)}}else{aK.top=Math.round(q.top+aC.p2c(aH.v)-aC.labelHeight/2);if(aC.position=="left"){aK.right=G-(aF.left+aF.width-aF.padding);aI="right"}else{aK.left=aF.left+aF.padding;aI="left"}}aK.width=aC.labelWidth;var aB=["position:absolute","text-align:"+aI];for(var aL in aK){aB.push(aL+":"+aK[aL]+"px")}aG.push('<div class="tickLabel" style="'+aB.join(";")+'">'+aH.label+"</div>")}aG.push("</div>")}aG.push("</div>");av.append(aG.join(""))}function d(aB){if(aB.lines.show){at(aB)}if(aB.bars.show){e(aB)}if(aB.points.show){ao(aB)}}function at(aE){function aD(aP,aQ,aI,aU,aT){var aV=aP.points,aJ=aP.pointsize,aN=null,aM=null;H.beginPath();for(var aO=aJ;aO<aV.length;aO+=aJ){var aL=aV[aO-aJ],aS=aV[aO-aJ+1],aK=aV[aO],aR=aV[aO+1];if(aL==null||aK==null){continue}if(aS<=aR&&aS<aT.min){if(aR<aT.min){continue}aL=(aT.min-aS)/(aR-aS)*(aK-aL)+aL;aS=aT.min}else{if(aR<=aS&&aR<aT.min){if(aS<aT.min){continue}aK=(aT.min-aS)/(aR-aS)*(aK-aL)+aL;aR=aT.min}}if(aS>=aR&&aS>aT.max){if(aR>aT.max){continue}aL=(aT.max-aS)/(aR-aS)*(aK-aL)+aL;aS=aT.max}else{if(aR>=aS&&aR>aT.max){if(aS>aT.max){continue}aK=(aT.max-aS)/(aR-aS)*(aK-aL)+aL;aR=aT.max}}if(aL<=aK&&aL<aU.min){if(aK<aU.min){continue}aS=(aU.min-aL)/(aK-aL)*(aR-aS)+aS;aL=aU.min}else{if(aK<=aL&&aK<aU.min){if(aL<aU.min){continue}aR=(aU.min-aL)/(aK-aL)*(aR-aS)+aS;aK=aU.min}}if(aL>=aK&&aL>aU.max){if(aK>aU.max){continue}aS=(aU.max-aL)/(aK-aL)*(aR-aS)+aS;aL=aU.max}else{if(aK>=aL&&aK>aU.max){if(aL>aU.max){continue}aR=(aU.max-aL)/(aK-aL)*(aR-aS)+aS;aK=aU.max}}if(aL!=aN||aS!=aM){H.moveTo(aU.p2c(aL)+aQ,aT.p2c(aS)+aI)}aN=aK;aM=aR;H.lineTo(aU.p2c(aK)+aQ,aT.p2c(aR)+aI)}H.stroke()}function aF(aI,aQ,aP){var aW=aI.points,aV=aI.pointsize,aN=Math.min(Math.max(0,aP.min),aP.max),aX=0,aU,aT=false,aM=1,aL=0,aR=0;while(true){if(aV>0&&aX>aW.length+aV){break}aX+=aV;var aZ=aW[aX-aV],aK=aW[aX-aV+aM],aY=aW[aX],aJ=aW[aX+aM];if(aT){if(aV>0&&aZ!=null&&aY==null){aR=aX;aV=-aV;aM=2;continue}if(aV<0&&aX==aL+aV){H.fill();aT=false;aV=-aV;aM=1;aX=aL=aR+aV;continue}}if(aZ==null||aY==null){continue}if(aZ<=aY&&aZ<aQ.min){if(aY<aQ.min){continue}aK=(aQ.min-aZ)/(aY-aZ)*(aJ-aK)+aK;aZ=aQ.min}else{if(aY<=aZ&&aY<aQ.min){if(aZ<aQ.min){continue}aJ=(aQ.min-aZ)/(aY-aZ)*(aJ-aK)+aK;aY=aQ.min}}if(aZ>=aY&&aZ>aQ.max){if(aY>aQ.max){continue}aK=(aQ.max-aZ)/(aY-aZ)*(aJ-aK)+aK;aZ=aQ.max}else{if(aY>=aZ&&aY>aQ.max){if(aZ>aQ.max){continue}aJ=(aQ.max-aZ)/(aY-aZ)*(aJ-aK)+aK;aY=aQ.max}}if(!aT){H.beginPath();H.moveTo(aQ.p2c(aZ),aP.p2c(aN));aT=true}if(aK>=aP.max&&aJ>=aP.max){H.lineTo(aQ.p2c(aZ),aP.p2c(aP.max));H.lineTo(aQ.p2c(aY),aP.p2c(aP.max));continue}else{if(aK<=aP.min&&aJ<=aP.min){H.lineTo(aQ.p2c(aZ),aP.p2c(aP.min));H.lineTo(aQ.p2c(aY),aP.p2c(aP.min));continue}}var aO=aZ,aS=aY;if(aK<=aJ&&aK<aP.min&&aJ>=aP.min){aZ=(aP.min-aK)/(aJ-aK)*(aY-aZ)+aZ;aK=aP.min}else{if(aJ<=aK&&aJ<aP.min&&aK>=aP.min){aY=(aP.min-aK)/(aJ-aK)*(aY-aZ)+aZ;aJ=aP.min}}if(aK>=aJ&&aK>aP.max&&aJ<=aP.max){aZ=(aP.max-aK)/(aJ-aK)*(aY-aZ)+aZ;aK=aP.max}else{if(aJ>=aK&&aJ>aP.max&&aK<=aP.max){aY=(aP.max-aK)/(aJ-aK)*(aY-aZ)+aZ;aJ=aP.max}}if(aZ!=aO){H.lineTo(aQ.p2c(aO),aP.p2c(aK))}H.lineTo(aQ.p2c(aZ),aP.p2c(aK));H.lineTo(aQ.p2c(aY),aP.p2c(aJ));if(aY!=aS){H.lineTo(aQ.p2c(aY),aP.p2c(aJ));H.lineTo(aQ.p2c(aS),aP.p2c(aJ))}}}H.save();H.translate(q.left,q.top);H.lineJoin="round";var aG=aE.lines.lineWidth,aB=aE.shadowSize;if(aG>0&&aB>0){H.lineWidth=aB;H.strokeStyle="rgba(0,0,0,0.1)";var aH=Math.PI/18;aD(aE.datapoints,Math.sin(aH)*(aG/2+aB/2),Math.cos(aH)*(aG/2+aB/2),aE.xaxis,aE.yaxis);H.lineWidth=aB/2;aD(aE.datapoints,Math.sin(aH)*(aG/2+aB/4),Math.cos(aH)*(aG/2+aB/4),aE.xaxis,aE.yaxis)}H.lineWidth=aG;H.strokeStyle=aE.color;var aC=ae(aE.lines,aE.color,0,w);if(aC){H.fillStyle=aC;aF(aE.datapoints,aE.xaxis,aE.yaxis)}if(aG>0){aD(aE.datapoints,0,0,aE.xaxis,aE.yaxis)}H.restore()}function ao(aE){function aH(aN,aM,aU,aK,aS,aT,aQ,aJ){var aR=aN.points,aI=aN.pointsize;for(var aL=0;aL<aR.length;aL+=aI){var aP=aR[aL],aO=aR[aL+1];if(aP==null||aP<aT.min||aP>aT.max||aO<aQ.min||aO>aQ.max){continue}H.beginPath();aP=aT.p2c(aP);aO=aQ.p2c(aO)+aK;if(aJ=="circle"){H.arc(aP,aO,aM,0,aS?Math.PI:Math.PI*2,false)}else{aJ(H,aP,aO,aM,aS)}H.closePath();if(aU){H.fillStyle=aU;H.fill()}H.stroke()}}H.save();H.translate(q.left,q.top);var aG=aE.points.lineWidth,aC=aE.shadowSize,aB=aE.points.radius,aF=aE.points.symbol;if(aG>0&&aC>0){var aD=aC/2;H.lineWidth=aD;H.strokeStyle="rgba(0,0,0,0.1)";aH(aE.datapoints,aB,null,aD+aD/2,true,aE.xaxis,aE.yaxis,aF);H.strokeStyle="rgba(0,0,0,0.2)";aH(aE.datapoints,aB,null,aD/2,true,aE.xaxis,aE.yaxis,aF)}H.lineWidth=aG;H.strokeStyle=aE.color;aH(aE.datapoints,aB,ae(aE.points,aE.color),0,false,aE.xaxis,aE.yaxis,aF);H.restore()}function E(aN,aM,aV,aI,aQ,aF,aD,aL,aK,aU,aR,aC){var aE,aT,aJ,aP,aG,aB,aO,aH,aS;if(aR){aH=aB=aO=true;aG=false;aE=aV;aT=aN;aP=aM+aI;aJ=aM+aQ;if(aT<aE){aS=aT;aT=aE;aE=aS;aG=true;aB=false}}else{aG=aB=aO=true;aH=false;aE=aN+aI;aT=aN+aQ;aJ=aV;aP=aM;if(aP<aJ){aS=aP;aP=aJ;aJ=aS;aH=true;aO=false}}if(aT<aL.min||aE>aL.max||aP<aK.min||aJ>aK.max){return}if(aE<aL.min){aE=aL.min;aG=false}if(aT>aL.max){aT=aL.max;aB=false}if(aJ<aK.min){aJ=aK.min;aH=false}if(aP>aK.max){aP=aK.max;aO=false}aE=aL.p2c(aE);aJ=aK.p2c(aJ);aT=aL.p2c(aT);aP=aK.p2c(aP);if(aD){aU.beginPath();aU.moveTo(aE,aJ);aU.lineTo(aE,aP);aU.lineTo(aT,aP);aU.lineTo(aT,aJ);aU.fillStyle=aD(aJ,aP);aU.fill()}if(aC>0&&(aG||aB||aO||aH)){aU.beginPath();aU.moveTo(aE,aJ+aF);if(aG){aU.lineTo(aE,aP+aF)}else{aU.moveTo(aE,aP+aF)}if(aO){aU.lineTo(aT,aP+aF)}else{aU.moveTo(aT,aP+aF)}if(aB){aU.lineTo(aT,aJ+aF)}else{aU.moveTo(aT,aJ+aF)}if(aH){aU.lineTo(aE,aJ+aF)}else{aU.moveTo(aE,aJ+aF)}aU.stroke()}}function e(aD){function aC(aJ,aI,aL,aG,aK,aN,aM){var aO=aJ.points,aF=aJ.pointsize;for(var aH=0;aH<aO.length;aH+=aF){if(aO[aH]==null){continue}E(aO[aH],aO[aH+1],aO[aH+2],aI,aL,aG,aK,aN,aM,H,aD.bars.horizontal,aD.bars.lineWidth)}}H.save();H.translate(q.left,q.top);H.lineWidth=aD.bars.lineWidth;H.strokeStyle=aD.color;var aB=aD.bars.align=="left"?0:-aD.bars.barWidth/2;var aE=aD.bars.fill?function(aF,aG){return ae(aD.bars,aD.color,aF,aG)}:null;aC(aD.datapoints,aB,aB+aD.bars.barWidth,0,aE,aD.xaxis,aD.yaxis);H.restore()}function ae(aD,aB,aC,aF){var aE=aD.fill;if(!aE){return null}if(aD.fillColor){return am(aD.fillColor,aC,aF,aB)}var aG=c.color.parse(aB);aG.a=typeof aE=="number"?aE:0.4;aG.normalize();return aG.toString()}function o(){av.find(".legend").remove();if(!O.legend.show){return}var aH=[],aF=false,aN=O.legend.labelFormatter,aM,aJ;for(var aE=0;aE<Q.length;++aE){aM=Q[aE];aJ=aM.label;if(!aJ){continue}if(aE%O.legend.noColumns==0){if(aF){aH.push("</tr>")}aH.push("<tr>");aF=true}if(aN){aJ=aN(aJ,aM)}aH.push('<td class="legendColorBox"><div style="border:1px solid '+O.legend.labelBoxBorderColor+';padding:1px"><div style="width:4px;height:0;border:5px solid '+aM.color+';overflow:hidden"></div></div></td><td class="legendLabel">'+aJ+"</td>")}if(aF){aH.push("</tr>")}if(aH.length==0){return}var aL='<table style="font-size:smaller;color:'+O.grid.color+'">'+aH.join("")+"</table>";if(O.legend.container!=null){c(O.legend.container).html(aL)}else{var aI="",aC=O.legend.position,aD=O.legend.margin;if(aD[0]==null){aD=[aD,aD]}if(aC.charAt(0)=="n"){aI+="top:"+(aD[1]+q.top)+"px;"}else{if(aC.charAt(0)=="s"){aI+="bottom:"+(aD[1]+q.bottom)+"px;"}}if(aC.charAt(1)=="e"){aI+="right:"+(aD[0]+q.right)+"px;"}else{if(aC.charAt(1)=="w"){aI+="left:"+(aD[0]+q.left)+"px;"}}var aK=c('<div class="legend">'+aL.replace('style="','style="position:absolute;'+aI+";")+"</div>").appendTo(av);if(O.legend.backgroundOpacity!=0){var aG=O.legend.backgroundColor;if(aG==null){aG=O.grid.backgroundColor;if(aG&&typeof aG=="string"){aG=c.color.parse(aG)}else{aG=c.color.extract(aK,"background-color")}aG.a=1;aG=aG.toString()}var aB=aK.children();c('<div style="position:absolute;width:'+aB.width()+"px;height:"+aB.height()+"px;"+aI+"background-color:"+aG+';"> </div>').prependTo(aK).css("opacity",O.legend.backgroundOpacity)}}}var ab=[],M=null;function K(aI,aG,aD){var aO=O.grid.mouseActiveRadius,a0=aO*aO+1,aY=null,aR=false,aW,aU;for(aW=Q.length-1;aW>=0;--aW){if(!aD(Q[aW])){continue}var aP=Q[aW],aH=aP.xaxis,aF=aP.yaxis,aV=aP.datapoints.points,aT=aP.datapoints.pointsize,aQ=aH.c2p(aI),aN=aF.c2p(aG),aC=aO/aH.scale,aB=aO/aF.scale;if(aH.options.inverseTransform){aC=Number.MAX_VALUE}if(aF.options.inverseTransform){aB=Number.MAX_VALUE}if(aP.lines.show||aP.points.show){for(aU=0;aU<aV.length;aU+=aT){var aK=aV[aU],aJ=aV[aU+1];if(aK==null){continue}if(aK-aQ>aC||aK-aQ<-aC||aJ-aN>aB||aJ-aN<-aB){continue}var aM=Math.abs(aH.p2c(aK)-aI),aL=Math.abs(aF.p2c(aJ)-aG),aS=aM*aM+aL*aL;if(aS<a0){a0=aS;aY=[aW,aU/aT]}}}if(aP.bars.show&&!aY){var aE=aP.bars.align=="left"?0:-aP.bars.barWidth/2,aX=aE+aP.bars.barWidth;for(aU=0;aU<aV.length;aU+=aT){var aK=aV[aU],aJ=aV[aU+1],aZ=aV[aU+2];if(aK==null){continue}if(Q[aW].bars.horizontal?(aQ<=Math.max(aZ,aK)&&aQ>=Math.min(aZ,aK)&&aN>=aJ+aE&&aN<=aJ+aX):(aQ>=aK+aE&&aQ<=aK+aX&&aN>=Math.min(aZ,aJ)&&aN<=Math.max(aZ,aJ))){aY=[aW,aU/aT]}}}}if(aY){aW=aY[0];aU=aY[1];aT=Q[aW].datapoints.pointsize;return{datapoint:Q[aW].datapoints.points.slice(aU*aT,(aU+1)*aT),dataIndex:aU,series:Q[aW],seriesIndex:aW}}return null}function aa(aB){if(O.grid.hoverable){u("plothover",aB,function(aC){return aC.hoverable!=false})}}function l(aB){if(O.grid.hoverable){u("plothover",aB,function(aC){return false})}}function R(aB){u("plotclick",aB,function(aC){return aC.clickable!=false})}function u(aC,aB,aD){var aE=y.offset(),aH=aB.pageX-aE.left-q.left,aF=aB.pageY-aE.top-q.top,aJ=C({left:aH,top:aF});aJ.pageX=aB.pageX;aJ.pageY=aB.pageY;var aK=K(aH,aF,aD);if(aK){aK.pageX=parseInt(aK.series.xaxis.p2c(aK.datapoint[0])+aE.left+q.left);aK.pageY=parseInt(aK.series.yaxis.p2c(aK.datapoint[1])+aE.top+q.top)}if(O.grid.autoHighlight){for(var aG=0;aG<ab.length;++aG){var aI=ab[aG];if(aI.auto==aC&&!(aK&&aI.series==aK.series&&aI.point[0]==aK.datapoint[0]&&aI.point[1]==aK.datapoint[1])){T(aI.series,aI.point)}}if(aK){x(aK.series,aK.datapoint,aC)}}av.trigger(aC,[aJ,aK])}function f(){if(!M){M=setTimeout(s,30)}}function s(){M=null;A.save();A.clearRect(0,0,G,I);A.translate(q.left,q.top);var aC,aB;for(aC=0;aC<ab.length;++aC){aB=ab[aC];if(aB.series.bars.show){v(aB.series,aB.point)}else{ay(aB.series,aB.point)}}A.restore();an(ak.drawOverlay,[A])}function x(aD,aB,aF){if(typeof aD=="number"){aD=Q[aD]}if(typeof aB=="number"){var aE=aD.datapoints.pointsize;aB=aD.datapoints.points.slice(aE*aB,aE*(aB+1))}var aC=al(aD,aB);if(aC==-1){ab.push({series:aD,point:aB,auto:aF});f()}else{if(!aF){ab[aC].auto=false}}}function T(aD,aB){if(aD==null&&aB==null){ab=[];f()}if(typeof aD=="number"){aD=Q[aD]}if(typeof aB=="number"){aB=aD.data[aB]}var aC=al(aD,aB);if(aC!=-1){ab.splice(aC,1);f()}}function al(aD,aE){for(var aB=0;aB<ab.length;++aB){var aC=ab[aB];if(aC.series==aD&&aC.point[0]==aE[0]&&aC.point[1]==aE[1]){return aB}}return -1}function ay(aE,aD){var aC=aD[0],aI=aD[1],aH=aE.xaxis,aG=aE.yaxis;if(aC<aH.min||aC>aH.max||aI<aG.min||aI>aG.max){return}var aF=aE.points.radius+aE.points.lineWidth/2;A.lineWidth=aF;A.strokeStyle=c.color.parse(aE.color).scale("a",0.5).toString();var aB=1.5*aF,aC=aH.p2c(aC),aI=aG.p2c(aI);A.beginPath();if(aE.points.symbol=="circle"){A.arc(aC,aI,aB,0,2*Math.PI,false)}else{aE.points.symbol(A,aC,aI,aB,false)}A.closePath();A.stroke()}function v(aE,aB){A.lineWidth=aE.bars.lineWidth;A.strokeStyle=c.color.parse(aE.color).scale("a",0.5).toString();var aD=c.color.parse(aE.color).scale("a",0.5).toString();var aC=aE.bars.align=="left"?0:-aE.bars.barWidth/2;E(aB[0],aB[1],aB[2]||0,aC,aC+aE.bars.barWidth,0,function(){return aD},aE.xaxis,aE.yaxis,A,aE.bars.horizontal,aE.bars.lineWidth)}function am(aJ,aB,aH,aC){if(typeof aJ=="string"){return aJ}else{var aI=H.createLinearGradient(0,aH,0,aB);for(var aE=0,aD=aJ.colors.length;aE<aD;++aE){var aF=aJ.colors[aE];if(typeof aF!="string"){var aG=c.color.parse(aC);if(aF.brightness!=null){aG=aG.scale("rgb",aF.brightness)}if(aF.opacity!=null){aG.a*=aF.opacity}aF=aG.toString()}aI.addColorStop(aE/(aD-1),aF)}return aI}}}c.plot=function(g,e,d){var f=new b(c(g),e,d,c.plot.plugins);return f};c.plot.version="0.7";c.plot.plugins=[];c.plot.formatDate=function(l,f,h){var o=function(d){d=""+d;return d.length==1?"0"+d:d};var e=[];var p=false,j=false;var n=l.getUTCHours();var k=n<12;if(h==null){h=["Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"]}if(f.search(/%p|%P/)!=-1){if(n>12){n=n-12}else{if(n==0){n=12}}}for(var g=0;g<f.length;++g){var m=f.charAt(g);if(p){switch(m){case"h":m=""+n;break;case"H":m=o(n);break;case"M":m=o(l.getUTCMinutes());break;case"S":m=o(l.getUTCSeconds());break;case"d":m=""+l.getUTCDate();break;case"m":m=""+(l.getUTCMonth()+1);break;case"y":m=""+l.getUTCFullYear();break;case"b":m=""+h[l.getUTCMonth()];break;case"p":m=(k)?("am"):("pm");break;case"P":m=(k)?("AM"):("PM");break;case"0":m="";j=true;break}if(m&&j){m=o(m);j=false}e.push(m);if(!j){p=false}}else{if(m=="%"){p=true}else{e.push(m)}}}return e.join("")};function a(e,d){return d*Math.floor(e/d)}})(jQuery);--/* NOTE: flot.resize.js included below */--/*-Flot plugin for automatically redrawing plots when the placeholder-size changes, e.g. on window resizes.--It works by listening for changes on the placeholder div (through the-jQuery resize event plugin) - if the size changes, it will redraw the-plot.--There are no options. If you need to disable the plugin for some-plots, you can just fix the size of their placeholders.-*/---/*-Flot plugin for automatically redrawing plots when the placeholder-size changes, e.g. on window resizes.--It works by listening for changes on the placeholder div (through the-jQuery resize event plugin) - if the size changes, it will redraw the-plot.--There are no options. If you need to disable the plugin for some-plots, you can just fix the size of their placeholders.-*/---/* Inline dependency: - * jQuery resize event - v1.1 - 3/14/2010- * http://benalman.com/projects/jquery-resize-plugin/- * - * Copyright (c) 2010 "Cowboy" Ben Alman- * Dual licensed under the MIT and GPL licenses.- * http://benalman.com/about/license/- */-(function($,h,c){var a=$([]),e=$.resize=$.extend($.resize,{}),i,k="setTimeout",j="resize",d=j+"-special-event",b="delay",f="throttleWindow";e[b]=250;e[f]=true;$.event.special[j]={setup:function(){if(!e[f]&&this[k]){return false}var l=$(this);a=a.add(l);$.data(this,d,{w:l.width(),h:l.height()});if(a.length===1){g()}},teardown:function(){if(!e[f]&&this[k]){return false}var l=$(this);a=a.not(l);l.removeData(d);if(!a.length){clearTimeout(i)}},add:function(l){if(!e[f]&&this[k]){return false}var n;function m(s,o,p){var q=$(this),r=$.data(this,d);r.w=o!==c?o:q.width();r.h=p!==c?p:q.height();n.apply(this,arguments)}if($.isFunction(l)){n=l;return m}else{n=l.handler;l.handler=m}}};function g(){i=h[k](function(){a.each(function(){var n=$(this),m=n.width(),l=n.height(),o=$.data(this,d);if(m!==o.w||l!==o.h){n.trigger(j,[o.w=m,o.h=l])}});g()},e[b])}})(jQuery,this);---(function ($) {-    var options = { }; // no options--    function init(plot) {-        function onResize() {-            var placeholder = plot.getPlaceholder();--            // somebody might have hidden us and we can't plot-            // when we don't have the dimensions-            if (placeholder.width() == 0 || placeholder.height() == 0)-                return;--            plot.resize();-            plot.setupGrid();-            plot.draw();-        }-        -        function bindEvents(plot, eventHolder) {-            plot.getPlaceholder().resize(onResize);-        }--        function shutdown(plot, eventHolder) {-            plot.getPlaceholder().unbind("resize", onResize);-        }-        -        plot.hooks.bindEvents.push(bindEvents);-        plot.hooks.shutdown.push(shutdown);-    }-    -    $.plot.plugins.push({-        init: init,-        options: options,-        name: 'resize',-        version: '1.0'-    });-})(jQuery);
+ html/profile.html view
@@ -0,0 +1,210 @@+<!DOCTYPE html>+<html lang="en">+<head>++<meta charset="utf-8" />+<title>Shake report</title>++<!-- Profiling output -->+<script src="data/profile-data.js"></script>+<script src="data/metadata.js"></script>+<!-- Libraries -->+<script src="lib/jquery.js"></script>+<script src="lib/jquery.flot.js"></script>+<script src="lib/jquery.flot.stack.js"></script>+<script src="lib/jquery.dgtable.js"></script>+<!-- Functions for creating info from Shake builds -->+<script src="shake.js"></script>++<style type="text/css">+body {font-family: sans-serif; font-size: 10pt; background-color: #e8e8e8;}+.data {font-size: 9pt; border-spacing: 0px; border-collapse: collapse;}+.data td {padding-left: 7px; padding-right: 7px;}+.header {font-weight: bold; background-color: #eee !important;}+.header td:hover {background-color: #ccc !important;}+.header td {border: 1px solid #ccc; cursor: pointer;}+.data tr:hover {background-color: #ddd !important; color: black !important;}+* {box-sizing: border-box;}+html, body, .fill {height: 100%; width:100%;}+table.fill {border-spacing: 0px;}+input:focus {border-color: rgb(77, 144, 254) !important; outline-width: 0px !important;}+.note {margin-left: 10px;}+.note, .note a {color: gray;}+a tt {color: #315273;}++.tabstrip a {+    border-radius: 4px 4px 0px 0px;+    border: 1px solid gray;+    padding: 4px 8px;+    box-sizing: border-box;+    cursor: pointer;+    white-space: nowrap;+    user-select: none;+ }+.tabstrip .bottom {+    padding: 4px 8px;+    border-bottom: 1px solid gray;+}+.tabstrip .active {+    border-top: 4px solid orange;+    border-bottom: 3px solid white;+    background-color: white;+}+.right { text-align: right; }+.dropdown {+    border:1px solid gray;+    background-color:white;+    white-space:nowrap;+    position:absolute;+    right:10px;+    padding-right:10px;+    box-shadow: 3px 3px 5px #ccc;+    z-index: 100;+}+.dropdown a tt {+    cursor: pointer;+    color: #1467bb !important;+}+.details a {+    cursor: pointer;+    color: #1467bb;+}++/* My overrides */+/* Make the colors and font size match better */+.dgtable-row:hover { background-color: #e8e8e8 !important; }+.dgtable-header-cell:hover { background-color: #ddd !important; }+.dgtable-header-cell { background-color: #eee !important; }+.dgtable-cell:last-child, .dgtable-header-cell:last-child { border-right: 1px solid #ccc; }++/* Make the header smaller */+.dgtable-header-row, .dgtable-header-cell { height: 22px !important; }+.dgtable-header-cell { padding: 2px 4px !important; }+.dgtable-header-cell, .dgtable-cell-preview.header { font-size: 9pt !important; }++/* Make the rows smaller */+.dgtable-row { height: 22px !important; }+.dgtable-row:first-child { height: 23px !important; }+.dgtable-cell { padding: 2px 4px !important; height: 22px !important; }+.dgtable-cell, .dgtable-cell-preview{ font-size: 9pt !important; }++.dgtable-wrapper * {+    box-sizing: border-box;+}+.dgtable-wrapper {+    border: solid 1px #ccc;+}+.dgtable {+    border-top: solid 1px #ccc;+    max-width: 100%;+    background-color: transparent;+}+.dgtable-header {+    max-width: 100%;+    overflow: hidden;+    background: #eee;+}+.dgtable-header-row {+    height: 26px;+}+.dgtable-header-cell {+    float: left;+    padding: 4px;+    height: 26px;+    border-left: solid 1px #ccc;+    background: #ddd;+    font-size: 13px;+    line-height: 16px;+    font-weight: bold;+    cursor: default;+    text-align: left;+}+.dgtable-header-cell:first-child {+    border-left: 0;+}+.dgtable-header-cell > div {+    border: 1px dashed transparent;+    white-space: nowrap;+    overflow-x: hidden;+    text-overflow: ellipsis;+}+.dgtable-header-cell.drag-over > div {+    border-color: #666;+    background: #bbb;+}+.dgtable-row {+    border-top: solid 1px #ccc;+    height: 28px;+}+.dgtable-row:first-child {+    border-top: 0;+    height: 29px;+}+.dgtable.virtual .dgtable-row {+    border-top: 0;+    border-bottom: solid 1px #ccc;+}+.dgtable-cell {+    float: left;+    padding: 4px 4px 4px;+    height: 28px;+    border-left: solid 1px #ccc;+    font-size: 16px;+    line-height: 19px;+}+.dgtable-cell > div {+    max-height: 100%;+    white-space: nowrap;+    overflow: hidden+}+.dgtable-cell:first-child {+    border-left: 0;+}+.dgtable-header-cell.sortable {+    cursor: pointer;+}+.dgtable-header-cell.sorted .sort-arrow {+    float: right;+    display: inline-block;+    width: 15px;+    height: 6px;+    margin: 5px 0 0 0;+    background: url("data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAsAAAAGCAMAAAAi7JTKAAAAIGNIUk0AAHolAACAgwAA+f8AAIDpAAB1MAAA6mAAADqYAAAXb5JfxUYAAAMAUExURQNOov///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAH52dxwAAAACdFJOU/8A5bcwSgAAAAlwSFlzAAALEwAACxMBAJqcGAAAAB9JREFUCB0FwQEBAAAAgJD8Px0VoFKgRKEIpRBUEAgMBlQAL3y6umEAAAAASUVORK5CYII=") no-repeat center center;+}++.dgtable-header-cell.sorted.desc .sort-arrow {+    background-image: url("data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAsAAAAGCAMAAAAi7JTKAAAAIGNIUk0AAHolAACAgwAA+f8AAIDpAAB1MAAA6mAAADqYAAAXb5JfxUYAAAMAUExURQNOov///wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAH52dxwAAAACdFJOU/8A5bcwSgAAAAlwSFlzAAALEwAACxMBAJqcGAAAAB9JREFUCB0FwQEBAAAAgJD8Px2BQFBBKIUoFClQKkANBywAL6PcDsUAAAAASUVORK5CYII=");+}++.dgtable-cell-preview {+    font-size: 16px;+    line-height: 19px;+}++/* Making the cell preview show correct styling when previewing header cells */+.dgtable-cell-preview.header {+    font-size: 13px;+    line-height: 16px;+    font-weight: bold;+    text-align: left;+}++.dgtable-cell-preview.header > div {+    border: 1px dashed transparent;+}++.dgtable-cell-preview.header.sortable {+    cursor: pointer;+}++.dgtable-cell-preview.header.drag-over > div {+    border-color: #666;+    background: #bbb;+}+</style>++</head>+<body style="margin:0px;padding:0px;" onload="profileLoaded(profile)">+    Loading...+</body>+</html>
+ html/progress.html view
@@ -0,0 +1,50 @@+<!DOCTYPE html>+<html lang="en">+<head>++<meta charset="utf-8" />+<title>Shake progress diagnostic</title>++<!-- Libraries -->+<script src="lib/jquery.js"></script>+<script src="lib/jquery.flot.js"></script>+<script src="lib/jquery.flot.stack.js"></script>+<!-- Progress output -->+<script src="data/progress-data.js"></script>+<script src="data/metadata.js"></script>+<!-- Functions for creating info from progress info -->+<script src="shake.js"></script>+<script>+initProgress();+</script>++<style type="text/css">+body {font-family: sans-serif; font-size: 10pt;}+h1 {font-size: 12pt;}+.version {color: gray; font-style: italic; clear: both; padding-top: 30px;}+.shake {+    text-decoration: none;+    font-family: monospace;+    color: black;+}+.plot {+    width: 300px;+    height: 200px;+    float: left;+}+</style>++</head>+<body>++<h1>Shake Progress Analysis</h1>+<p>+    The red line represents the real performance, with time to completion on the X axis and predicted time on the Y axis. A perfect progress prediction would follow the gray line.+</p>++<div id="output">Loading...</div>++<p class="version"></p>++</body>+</html>
− html/report.html
@@ -1,88 +0,0 @@-<!DOCTYPE html>-<html lang="en">-  <head>-    <meta charset="utf-8">-    <title>Shake report</title>-    <meta name="viewport" content="width=device-width, initial-scale=1.0">-    <meta name="description" content="Shake summary report">-    <meta name="author" content="N/A">-    <!-- Le styles -->-    <style>$bootstrap.min.css$</style>-    <style>-      body {-        padding-top:    20px; /* 60px to make the container go all the way to the bottom of the topbar */-        padding-bottom: 20px;-      }-    </style>-    <style>$bootstrap-responsive.min.css$</style>-    <!-- Le HTML5 shim, for IE6-8 support of HTML5 elements -->-    <!--[if lt IE 9]>-      <script src="http://html5shim.googlecode.com/svn/trunk/html5.js"></script>-    <![endif]-->-  </head>--  <body onload="load()">-    <div class="container">-      <div class="page-header">-        <h1>Shake Summary Report</h1>-      </div> <!-- /page-header -->--      <div class="row">-        <div class="span4" id="summary">-          <h2>Overview</h2>-        </div> <!-- /span -->-        <div class="span8" id="graph">-          <h2>Traced commands</h2>-          <div id="shakeplot" style="width:80%;height:200px;"></div>-        </div> <!-- /span -->-      </div> <!-- /row -->-      <hr>-      <div class="row">-        <div class="span6" id="rules">-          <h2>Expensive rules</h2>-          <table id='rule-details' class='table'>-            <thead><tr>-              <th></th>-              <th>Time</th>-              <th>Overall %</th>-              <th>Rule</th>-            </tr></thead>-          </table>-        </div> <!-- /span -->-        <div class="span6" id="commands">-          <h2>Expensive commands</h2>-          <table id='cmd-details' class='table'>-            <thead><tr>-              <th></th>-              <th>Time</th>-              <th>Overall %</th>-              <th>Invocations</th>-              <th>Name</th>-            </tr></thead>-          </table>-        </div> <!-- /span -->-      </div> <!-- /row -->-    <hr>-    <footer>-      <p>This build report was generated by the <a href="http://hackage.haskell.org/package/shake">shake</a>-      build system.</p>--      <p>CSS provided by <a href="http://twitter.github.com/bootstrap">Bootstrap</a>. Graph generated with-      <a href="http://jquery.com">jQuery</a>/<a href="http://code.google.com/p/flot">flot</a>.-    </footer>-    </div> <!-- /container -->---    <!-- Le javascript-    ================================================== -->-    <!-- Placed at the end of the document so the pages load faster -->-    <script>$jquery-1.6.4.min.js$</script>-    <script>$jquery.flot.min.js$</script>-    <!-- <script>$bootstrap.min.js$</script> -->--    <!-- Profiling output -->-    <script>var shake = $data$</script>-    <!-- Functions for creating info from Shake builds -->-    <script>$shake.js$</script>-  </body>-</html>
html/shake.js view
@@ -1,245 +1,1029 @@-// first find which runs have built data in them, sorted-// built :: [Int]-var built = function(){-  var seen = {};-  for (var i = 0; i < shake.length; i++)-    seen[shake[i].built] = true;-  var seen2 = [];-  for (var i in seen)-    seen2.push(i);-  return seen2.sort(function cmp(a,b){return a-b;});-}();--// what is the index of the last build run-// lastRun :: Int-var lastRun = built.length == 0 ? 0 : built[built.length-1];--function showTime(x){return x.toFixed(2) + "s";}-function showPerc(x){return (x*100).toFixed(2) + "%";}-function showShort(x){return x;}--function plural(n,not1,is1){-  return n == 1-    ? (is1 == undefined ? "" : is1)-    : (not1 == undefined ? "s" : not1);-}---function listEq(xs, ys)-{-  if (xs.length != ys.length) return false;-  for (var i = 0; i < xs.length; i++)-    if (xs[i] != ys[i]) return false;-  return true;-}--// Return the n top entries, grouping as necessary by words-// huffman :: Int -> [{sum :: Double, name :: String}] -> [{sum :: Double, count :: Int, name :: String}]-function huffman(resultSize, xs)-{-  var val = {sum: 0, count: 0, children: {}};--  for (var i = 0; i < xs.length; i++)-  {-    var val2 = val;-    var ys = xs[i].name.split(' ');-    for (var j = 0; j < ys.length; j++)-    {-      if (val2.children[ys[j]])-        val2 = val2.children[ys[j]];-      else-      {-        var t = {sum: 0, count: 0, children: {}};-        val2.children[ys[j]] = t;-        val2 = t;-      }-      val2.sum += xs[i].sum;-      val2.count++;-    }-  }--  function compress(val) // return the number of items-  {-    var n = 0;-    for (var j in val.children)-      n += compress(val.children[j]);-    if (n == 1)-      val.children = {};-    return Math.max(1,n);-  }-  compress(val);--  function flatten(path, val, res)-  {-    for (var i in val.children)-    {-      var ii = val.children[i];-      var pp = path.slice(0);-      pp.push(i);-      res.push({sum:ii.sum, count:ii.count, name:pp, free:path.length==0});-      flatten(pp,ii,res);-    }-  }-  var flat = [];-  flatten([], val, flat);--  while(true)-  {-    // order everything-    flat.sort(function(a,b){var i = b.sum - a.sum; return i != 0 ? i : b.count - a.count;});--    // now, if something in the first n is not free, mark it free and delete anyone who relies on it-    // then repeat, if nothing is not free, break-    var cont = false;-    for (var i = 0; i < Math.min(resultSize, flat.length); i++)-    {-      if (!flat[i].free)-      {-        cont = true;-        flat[i].free = true;-        for (var j = 0; j < flat.length; j++)-        {-          if (listEq(flat[i].name.slice(0,flat[i].name.length-1), flat[j].name))-          {-            flat[j].count -= flat[i].count;-            flat[j].sum -= flat[i].sum;-          }-        }-        break;-      }-    }-    if (!cont) break;-  }--  for (var i = 0; i < flat.length; i++)-    flat[i].name = flat[i].name.join(" ");-  return flat.slice(0, resultSize);-}---function load()-{-  /////////////////////////////////////////////////////////////////-  // SUMMARY INFORMATION--  var countLast = 0;-  var sumExecution = 0;-  var maxExecution = 0;-  var countTrace = 0, countTraceLast = 0;-  var sumTrace = 0;-  var maxTrace = 0;-  var maxTraceStopLast = 0;-  for (var i = 0; i < shake.length; i++)-  {-    var isLast = shake[i].built == lastRun;-    countLast += isLast ? 1 : 0;-    sumExecution += shake[i].execution;-    maxExecution = Math.max(maxExecution, shake[i].execution);-    var traces = shake[i].traces;-    if (!traces) continue;-    for (var j = 0; j < traces.length; j++)-    {-      countTrace += 1;-      countTraceLast += isLast ? 1 : 0;-      sumTrace += traces[j].stop - traces[j].start;-      maxTrace = Math.max(maxTrace, traces[j].stop - traces[j].start);-      maxTraceStopLast = Math.max(maxTraceStopLast, isLast ? traces[j].stop : 0);-    }-  }--  var summary =-    "<ul>" +-    "<li><strong>Runs:</strong> This database has tracked " + built.length + " run" + plural(built.length) + ".</li>" +-    "<li><strong>Rules:</strong> There are " + shake.length + " rules (" + countLast + " rebuilt in the last run).</li>" +-    "<li><strong>Commands:</strong> Building required " + countTrace + " traced commands (" + countTraceLast + " in the last run).</li>" +-    "<li><strong>Build time:</strong> The total (unparallelised) build time is " + showTime(sumExecution) + " of which " + showTime(sumTrace) + " is traced commands.</li>" +-    "<li><strong>Longest steps:</strong> The longest rule takes " + showTime(maxExecution) + ", and the longest traced command takes " + showTime(maxTrace) + ".</li>" +-    "<li><strong>Parallelism:</strong> Last run gave an average parallelism of " + (sumTrace / maxTraceStopLast).toFixed(2) + " times over " + showTime(maxTraceStopLast) + ".</li>" +-    "</ul>";-  $('#summary').append(summary);---  /////////////////////////////////////////////////////////////////-  // PARALLELISM GRAPH--  var buckets = [];-  var countBuckets = 100;-  for (var i = 0; i <= countBuckets; i++)-    buckets.push(0); // fill with 1 more element, but the last bucket will always be 0--  for (var i = 0; i < shake.length; i++)-  {-    var traces = shake[i].traces;-    if (!traces || shake[i].built != lastRun) continue;-    for (var j = 0; j < traces.length; j++)-    {-      var start = traces[j].start * countBuckets / maxTraceStopLast;-      var stop = traces[j].stop * countBuckets / maxTraceStopLast;--      if (Math.floor(start) == Math.floor(stop))-        buckets[Math.floor(start)] += stop - start;-      else-      {-        for (var k = Math.ceil(start); k < Math.floor(stop); k++)-          buckets[k]++;-        buckets[Math.floor(start)] += Math.ceil(start) - start;-        buckets[Math.floor(stop)] += stop - Math.floor(stop);-      }-    }-  }-  var maxBucket = 0;-  for (var i = 0; i < countBuckets; i++)-    maxBucket = Math.max(maxBucket, buckets[i]);-  maxBucket = Math.ceil(maxBucket - 0.00001);--  plotvals = [];-  for (var i = 0; i < countBuckets; i++)-    plotvals.push([i, (buckets[i] * 100 / maxBucket)]);-  $.plot($('#shakeplot'), [plotvals]);--  /////////////////////////////////////////////////////////////////-  // MOST EXPENSIVE RULES--  var top = shake.slice(0).sort(function(a,b){return b.execution-a.execution}).slice(0,15);-  var rules = "<tbody>";-  for (var i = 0; i < top.length; i++)-  {-    rules += "<tr>" +-      "<td><div class='progress progress-success' style='height: 10px'>" +-      "<div class='bar' style='width:" + (top[i].execution * 40 / top[0].execution) + "px;'></div></div></td>" +-      "<td>" + showTime(top[i].execution) + "</td>" +-      "<td>" + showPerc(top[i].execution / sumExecution) + "</td>" +-      "<td>" + top[i].name + "</td>" +-      "</tr>";-  }-  rules += "</tbody>";-  $('#rule-details').append(rules);--  /////////////////////////////////////////////////////////////////-  // MOST EXPENSIVE COMMANDS--  var tooList = [];-  for (var i = 0; i < shake.length; i++)-  {-    var traces = shake[i].traces;-    if (!traces) continue;-    for (var j = 0; j < traces.length; j++)-      tooList.push({name: traces[j].command, sum: traces[j].stop - traces[j].start});-  }--  toolList = huffman(15, tooList);-  var commands = "<tbody>";-  for (var i = 0; i < toolList.length; i++)-  {-    commands += "<tr>" +-      "<td><div class='progress progress-success' style='height: 10px'>" +-      "<div class='bar' style='width:" + (toolList[i].sum * 40 / toolList[0].sum) + "px;'></div></div></td>" +-      "<td>" + showTime(toolList[i].sum) + "</td>" +-      "<td>" + showPerc(toolList[i].sum / sumExecution) + "</td>" +-      "<td>" + toolList[i].count + "&nbsp;&times;</td>" +-      "<td>" + toolList[i].name + "</td>" +-      "</tr>";-  }-  commands += "</tbody>";-  $('#cmd-details').append(commands);+"use strict";+function bindPlot(element, data, options) {+    const redraw = () => {+        if ($(element).is(":visible"))+            $.plot($(element), data.get(), options);+    };+    window.setTimeout(redraw, 1);+    $(window).on("resize", redraw);+    data.event(redraw);+}+function varLink(name) {+    return React.createElement("a", { href: "https://hackage.haskell.org/package/shake/docs/Development-Shake.html#v:" + name },+        React.createElement("tt", null, name));+}+function newTable(columns, data, sortColumn, sortDescend) {+    const f = (x) => ({ name: x.field, label: x.label, width: x.width, cellClasses: x.alignRight ? "right" : "" });+    const formatters = {};+    for (const c of columns)+        formatters[c.field] = c.show || ((x) => x);+    const table = new DGTable({+        adjustColumnWidthForSortArrow: false,+        cellFormatter: (val, colname) => formatters[colname](val),+        columns: columns.map(f),+        width: DGTable.Width.SCROLL+    });+    $(table.el).css("height", "100%");+    window.setTimeout(() => {+        table.render();+        table.tableHeightChanged();+        if (sortColumn)+            table.sort(sortColumn, sortDescend);+        table.setRows(data.get(), true);+    }, 1);+    let toRender = false;+    data.event(xs => {+        table.setRows(xs, true);+        if ($(table.el).is(":visible"))+            table.render();+        else+            toRender = true;+    });+    $(window).on("resize", () => {+        if ($(table.el).is(":visible")) {+            table.tableHeightChanged();+            if (toRender) {+                table.render();+                toRender = false;+            }+        }+    });+    return React.createElement("div", { style: "height:100%;width:100%;" }, table.el);+}+// These are global variables mutated/queried by query execution+let environmentAll; // All the profiles+let environmentThis; // The specific profile under test+let environmentGroup; // The group produced as a result+function group(x) {+    environmentGroup.push(x);+    return true;+}+function leaf() {+    return environmentThis.depends.length === 0;+}+function run(i) {+    if (i === undefined)+        return environmentThis.built;+    else+        return environmentThis.built === i;+}+function changed() {+    return environmentThis.changed === environmentThis.built;+}+function unchanged() {+    return !unchanged();+}+function named(r, groupName) {+    if (r === undefined)+        return environmentThis.name;+    const res = execRegExp(r, environmentThis.name);+    if (res === null) {+        if (groupName === undefined)+            return false;+        else {+            group(groupName);+            return true;+        }+    }+    if (res.length !== 1) {+        for (let i = 1; i < res.length; i++)+            group(res[i]);+    }+    return true;+}+function command(r, groupName) {+    const n = (environmentThis.traces || []).length;+    if (r === undefined)+        return n === 0 ? "" : environmentThis.traces[0].command;+    for (const t of environmentThis.traces) {+        const res = execRegExp(r, t.command);+        if (res === null)+            continue;+        if (res.length !== 1) {+            for (let j = 1; j < res.length; j++)+                group(res[j]);+        }+        return true;+    }+    if (groupName === undefined)+        return false;+    else {+        group(groupName);+        return true;+    }+}+function profileLoaded(profileRaw) {+    $(document.body).empty().append(profileRoot(unraw(profileRaw)));+}+function unraw(xs) {+    const ans = xs.map((x, i) => ({+        index: i,+        name: x[0],+        execution: x[1],+        built: x[2],+        changed: x[3],+        depends: x.length > 4 ? x[4] : [],+        rdepends: [],+        traces: x.length > 5 ? x[5].map(y => ({ command: y[0], start: y[1], stop: y[2] })) : []+    }));+    for (const p of ans)+        for (const ds of p.depends)+            for (const d of ds)+                ans[d].rdepends.push(p.index);+    return ans;+}+function profileRoot(profile) {+    const [s, search] = createSearch(profile);+    const t = createTabs([["Summary", () => reportSummary(profile)],+        ["Command plot", () => reportCmdPlot(profile)],+        ["Commands", () => reportCmdTable(profile, search)],+        ["Rules", () => reportRuleTable(profile, search)],+        ["Parallelizability", () => reportParallelism(profile)],+        ["Details", () => reportDetails(profile, search)]+        // , ["Why rebuild", () => reportRebuild(profile, search)]+    ]);+    return React.createElement("table", { class: "fill" },+        React.createElement("tr", null,+            React.createElement("td", { style: "padding-top: 8px; padding-bottom: 8px;" },+                React.createElement("a", { href: "https://shakebuild.com/", style: "font-size: 20px; text-decoration: none; color: #3131a7; font-weight: bold;" }, "Shake profile report"),+                React.createElement("span", { style: "color:gray;white-space:pre;" },+                    "   - generated at ",+                    generated,+                    " by Shake v",+                    version))),+        React.createElement("tr", null,+            React.createElement("td", null, s)),+        React.createElement("tr", null,+            React.createElement("td", { height: "100%" }, t)));+}+function createTabs(xs) {+    const bodies = xs.map(x => {+        const el = React.createElement("div", { style: "padding:5px;width:100%;height:100%;min-width:150px;min-height:150px;overflow:auto;display:none;" });+        const upd = lazy(() => $(el).append(x[1]()));+        return pair(el, upd);+    });+    let lbls = [];+    const f = (i) => () => {+        bodies[i][1]();+        lbls.map((x, j) => $(x).toggleClass("active", i === j));+        bodies.map((x, j) => $(x[0]).toggle(i === j));+        $(window).trigger("resize");+    };+    lbls = xs.map((x, i) => React.createElement("a", { onclick: f(i) }, x[0]));+    f(0)();+    return React.createElement("table", { class: "fill" },+        React.createElement("tr", null,+            React.createElement("td", null,+                React.createElement("table", { width: "100%", style: "border-spacing:0px;" },+                    React.createElement("tr", { class: "tabstrip" },+                        React.createElement("td", { width: "20", class: "bottom" }, "\u00A0"),+                        React.createElement("td", { style: "padding:0px;" }, lbls),+                        React.createElement("td", { width: "100%", class: "bottom" }, "\u00A0"))))),+        React.createElement("tr", { height: "100%" },+            React.createElement("td", { style: "background-color:white;" }, bodies.map(fst))));+}+// A mapping from names (rule names or those matched from rule parts)+// to the indicies in profiles.+class Search {+    constructor(profile, mapping) {+        this.profile = profile;+        if (mapping !== undefined)+            this.mapping = mapping;+        else {+            this.mapping = {};+            for (const p of profile)+                this.mapping[p.name] = [p.index];+        }+    }+    forEachProfiles(f) {+        for (const s in this.mapping)+            f(this.mapping[s].map(i => this.profile[i]), s);+    }+    forEachProfile(f) {+        this.forEachProfiles((ps, group) => ps.forEach(p => f(p, group)));+    }+    mapProfiles(f) {+        const res = [];+        this.forEachProfiles((ps, group) => res.push(f(ps, group)));+        return res;+    }+    mapProfile(f) {+        const res = [];+        this.forEachProfile((p, group) => res.push(f(p, group)));+        return res;+    }+}+function createSearch(profile) {+    const caption = React.createElement("div", null,+        "Found ",+        profile.length,+        " entries, not filtered or grouped.");+    const input = React.createElement("input", { id: "search", type: "text", value: "", placeholder: "Filter and group", style: "width: 100%; font-size: 16px; border-radius: 8px; padding: 5px 10px; border: 2px solid #999;" });+    const res = new Prop(new Search(profile));+    $(input).on("change keyup paste", () => {+        const s = $(input).val();+        if (s === "") {+            res.set(new Search(profile));+            $(caption).text("Found " + profile.length + " entries, not filtered or grouped.");+        }+        else if (s.indexOf("(") === -1) {+            const mapping = {};+            let found = 0;+            for (const p of profile) {+                if (p.name.indexOf(s) !== -1) {+                    found++;+                    mapping[p.name] = [p.index];+                }+            }+            res.set(new Search(profile, mapping));+            $(caption).text("Substring filtered to " + found + " / " + profile.length + " entries, not grouped.");+        }+        else {+            let f;+            try {+                f = new Function("return " + s);+            }+            catch (e) {+                $(caption).text("Error compiling function, " + e);+                return;+            }+            const mapping = {};+            let groups = 0;+            let found = 0;+            environmentAll = profile;+            for (const p of profile) {+                environmentThis = p;+                environmentGroup = [];+                let bool;+                try {+                    bool = f();+                }+                catch (e) {+                    $(caption).text("Error running function, " + e);+                    return;+                }+                if (bool) {+                    found++;+                    const name = environmentGroup.length === 0 ? p.name : environmentGroup.join(" ");+                    if (name in mapping)+                        mapping[name].push(p.index);+                    else {+                        groups++;+                        mapping[name] = [p.index];+                    }+                }+            }+            res.set(new Search(profile, mapping));+            $(caption).text("Function filtered to " + found + " / " + profile.length + " entries, " ++                (groups === found ? "not grouped." : groups + " groups."));+        }+    });+    const body = React.createElement("table", { width: "100%", style: "padding-bottom: 17px;" },+        React.createElement("tr", null,+            React.createElement("td", { width: "100%" }, input),+            React.createElement("td", { style: "padding-left:6px;padding-right: 6px;" }, searchHelp(input))),+        React.createElement("tr", null,+            React.createElement("td", null, caption)));+    return [body, res];+}+function searchHelp(input) {+    const examples = [["Only the last run", "run(0)"],+        ["Named 'Main'", "named(\"Main\")"],+        ["Group by file extension", "named(/(\\.[_0-9a-z]+)$/)"],+        ["No dependencies (an input)", "leaf()"],+        ["Didn't change when it last rebuilt", "unchanged()"],+        ["Ran 'gcc'", "command(\"gcc\")"]+    ];+    const f = (code) => () => {+        $(input).val((i, x) => x + (x === "" ? "" : " && ") + code);+        $(input).trigger("change");+    };+    const dropdown = React.createElement("div", { class: "dropdown", style: "display:none;" },+        React.createElement("ul", { style: "padding-left:30px;" }, examples.map(([desc, code]) => React.createElement("li", null,+            React.createElement("a", { onclick: f(code) },+                React.createElement("tt", null, code)),+            " ",+            React.createElement("span", { class: "note" }, desc)))));+    const arrow_down = React.createElement("span", { style: "vertical-align:middle;font-size:80%;" }, "\u25BC");+    const arrow_up = React.createElement("span", { style: "vertical-align:middle;font-size:80%;display:none;" }, "\u25B2");+    const show_inner = () => { $(dropdown).toggle(); $(arrow_up).toggle(); $(arrow_down).toggle(); };+    return React.createElement("div", null,+        React.createElement("button", { style: "white-space:nowrap;padding-top:5px;padding-bottom:5px;", onclick: show_inner },+            React.createElement("b", { style: "font-size:150%;vertical-align:middle;" }, "+"),+            "\u00A0 Filter and Group \u00A0",+            arrow_down,+            arrow_up),+        dropdown);+}+function initProgress() {+    $(function () {+        $(".version").html("Generated by <a href='https://shakebuild.com'>Shake " + version + "</a>.");+        $("#output").html("");+        for (const x of progress) {+            var actual = [];+            var ideal = [];+            // Start at t = 5 seconds, since the early progress jumps a lot+            for (var t = 5; t < x.values.length; t++) {+                var y = x.values[t];+                actual.push([y.idealSecs, y.actualSecs]);+                ideal.push([y.idealSecs, y.idealSecs]);+            }+            var ys = [{ data: ideal, color: "gray" }, { label: x.name, data: actual, color: "red" }];+            var div = $("<div class='plot'>");+            $("#output").append(div);+            $.plot(div, ys, {+                xaxis: {+                    transform: function (v) { return -v; },+                    inverseTransform: function (v) { return -v; }+                }+            });+        }+    });+}+// Stuff that Shake generates and injects in+function untraced(p) {+    return Math.max(0, p.execution - p.traces.map(t => t.stop - t.start).sum());+}+/////////////////////////////////////////////////////////////////////+// BASIC UI TOOLKIT+class Prop {+    constructor(val) { this.val = val; this.callback = () => { return; }; }+    get() { return this.val; }+    set(val) {+        this.val = val;+        this.callback(val);+    }+    event(next) {+        const old = this.callback;+        this.callback = val => { old(val); next(val); };+        next(this.val);+    }+    map(f) {+        const res = new Prop(f(this.get()));+        this.event(a => res.set(f(a)));+        return res;+    }+}+jQuery.fn.enable = function (x) {+    // Set the values to enabled/disabled+    return this.each(function () {+        if (x)+            $(this).removeAttr("disabled");+        else+            $(this).attr("disabled", "disabled");+    });+};+/////////////////////////////////////////////////////////////////////+// BROWSER HELPER METHODS+// Given "?foo=bar&baz=1" returns {foo:"bar",baz:"1"}+function uriQueryParameters(s) {+    // From https://stackoverflow.com/questions/901115/get-querystring-values-with-jquery/3867610#3867610+    const params = {};+    const a = /\+/g; // Regex for replacing addition symbol with a space+    const r = /([^&=]+)=?([^&]*)/g;+    const d = (x) => decodeURIComponent(x.replace(a, " "));+    const q = s.substring(1);+    while (true) {+        const e = r.exec(q);+        if (!e)+            break;+        params[d(e[1])] = d(e[2]);+    }+    return params;+}+/////////////////////////////////////////////////////////////////////+// STRING FORMATTING+function showTime(x) {+    function digits(x) { const s = String(x); return s.length === 1 ? "0" + s : s; }+    if (x >= 3600) {+        x = Math.round(x / 60);+        return Math.floor(x / 60) + "h" + digits(x % 60) + "m";+    }+    else if (x >= 60) {+        x = Math.round(x);+        return Math.floor(x / 60) + "m" + digits(x % 60) + "s";+    }+    else+        return x.toFixed(2) + "s";+}+function showPerc(x) {+    return (x * 100).toFixed(2) + "%";+}+function showInt(x) {+    // From https://stackoverflow.com/questions/2901102/how-to-print-a-number-with-commas-as-thousands-separators-in-javascript+    // Show, with commas+    return x.toString().replace(/\B(?=(\d{3})+(?!\d))/g, ",");+}+function showRun(run) {+    return run === 0 ? "Latest run" : run + " run" + plural(run) + " ago";+}+function plural(n, not1 = "s", is1 = "") {+    return n === 1 ? is1 : not1;+}+/////////////////////////////////////////////////////////////////////+// MISC+function compareFst(a, b) {+    return a[0] - b[0];+}+function compareSnd(a, b) {+    return a[1] - b[1];+}+function compareSndRev(a, b) {+    return b[1] - a[1];+}+function pair(a, b) {+    return [a, b];+}+function triple(a, b, c) {+    return [a, b, c];+}+function fst([x, _]) {+    return x;+}+function snd([_, x]) {+    return x;+}+function execRegExp(r, s) {+    if (typeof r === "string")+        return s.indexOf(r) === -1 ? null : [];+    else+        return r.exec(s);+}+function cache(key, op) {+    const store = {};+    return k => {+        const s = key(k);+        if (!(s in store))+            store[s] = op(k);+        return store[s];+    };+}+function lazy(thunk) {+    let store = null;+    let done = false;+    return () => {+        if (!done) {+            store = thunk();+            done = true;+        }+        return store;+    };+}+Array.prototype.sum = function () {+    let res = 0;+    for (const x of this)+        res += x;+    return res;+};+Array.prototype.insertSorted = function (x, compare) {+    let start = 0;+    let stop = this.length - 1;+    let middle = 0;+    while (start <= stop) {+        middle = Math.floor((start + stop) / 2);+        if (compare(this[middle], x) > 0)+            stop = middle - 1;+        else+            start = middle + 1;+    }+    this.splice(start, 0, x);+    return this;+};+Array.prototype.concatLength = function () {+    let res = 0;+    for (const x of this)+        res += x.length;+    return res;+};+Array.prototype.sortOn = function (f) {+    return this.map(x => pair(f(x), x)).sort(compareFst).map(snd);+};+Array.prototype.last = function () {+    return this[this.length - 1];+};+Array.prototype.maximum = function (def) {+    if (this.length === 0)+        return def;+    let res = this[0];+    for (let i = 1; i < this.length; i++)+        res = Math.max(res, this[i]);+    return res;+};+Array.prototype.minimum = function (def) {+    if (this.length === 0)+        return def;+    let res = this[0];+    for (let i = 1; i < this.length; i++)+        res = Math.min(res, this[i]);+    return res;+};+// Use JSX with el instead of React.createElement+// Originally from https://gist.github.com/sergiodxa/a493c98b7884128081bb9a281952ef33+// our element factory+function createElement(type, props, ...children) {+    const element = document.createElement(type);+    for (const name in props || {}) {+        if (name.substr(0, 2) === "on")+            element.addEventListener(name.substr(2), props[name]);+        else+            element.setAttribute(name, props[name]);+    }+    for (const child of children.flat(10)) {+        const c = typeof child === "object" ? child : document.createTextNode(child.toString());+        element.appendChild(c);+    }+    return element;+}+// How .tsx gets desugared+const React = { createElement };+function reportCmdPlot(profile) {+    // first find the end point+    const runs = findRuns(profile);+    if (runs.length === 0) {+        return React.createElement("div", null,+            React.createElement("h2", null, "No data found"),+            React.createElement("p", null, "The Shake database contains no rules which ran traced commands."),+            React.createElement("p", null,+                "You can populate this information by using ",+                varLink("cmd"),+                " or wrapping your ",+                React.createElement("tt", null, "IO"),+                " actions in ",+                varLink("traced"),+                "."));+    }+    const combo = React.createElement("select", null,+        runs.map(([run, time], i) => React.createElement("option", null,+            showRun(run) + " (" + showTime(time) + ") ",+            i === 0 ? "" : " - may be incomplete")),+        ";");+    const warning = React.createElement("i", null);+    const plot = React.createElement("div", { style: "width:100%; height:100%;" });+    const plotData = new Prop([]);+    bindPlot(plot, plotData, {+        legend: { show: true, position: "nw", sorted: "reverse" },+        series: { stack: true, lines: { fill: 1, lineWidth: 0 } },+        yaxis: { min: 0 },+        xaxis: { tickFormatter: showTime }+    });+    function setPlotData(runsIndex) {+        const [run, end] = runs[runsIndex];+        const profileRun = profile.filter(p => p.built === run);+        // Make sure we max(0,) every step in the process, in case one does parallelism of threads+        const missing = profileRun.map(untraced).sum();+        $(warning).text(missing < 1 ? "" : "Warning: " + showTime(missing) + " of execution was not traced.");+        const series = calcPlotData(end, profileRun, 100);+        const res = [];+        for (const s in series)+            res.push({ label: s, data: series[s].map((x, i) => pair(end * i / 100, x)) });+        plotData.set(res);+    }+    setPlotData(0);+    $(combo).change(() => setPlotData(combo.selectedIndex));+    return React.createElement("table", { class: "fill" },+        React.createElement("tr", null,+            React.createElement("td", { width: "100%", style: "text-align:center;" },+                React.createElement("h2", null, "Number of commands executing over time")),+            React.createElement("td", null, combo)),+        React.createElement("tr", null,+            React.createElement("td", { height: "100%", colspan: "2" }, plot)),+        React.createElement("tr", null,+            React.createElement("td", { colspan: "2", style: "text-align:center;" },+                "Time since the start of building. ",+                warning)));+}+// Find which runs had traced commands and when the last stopped, sort so most recent first+function findRuns(profile) {+    const runs = {};+    for (const p of profile) {+        if (p.traces.length > 0) {+            if (p.traces.length === 1 && p.traces[0].command === "")+                continue; // the fake end command+            const old = runs[p.built];+            const end = p.traces.last().stop;+            runs[p.built] = old === undefined ? end : Math.max(old, end);+        }+    }+    const runsList = [];+    for (const i in runs)+        runsList.push(pair(Number(i), runs[i]));+    runsList.sort(compareFst);+    return runsList;+}+function calcPlotData(end, profile, buckets) {+    const ans = {};+    for (const p of profile) {+        for (const t of p.traces) {+            let xs;+            if (t.command in ans)+                xs = ans[t.command];+            else {+                xs = [];+                for (let i = 0; i < buckets; i++)+                    xs.push(0); // fill with 1 more element, but the last bucket will always be 0+                ans[t.command] = xs;+            }+            const start = t.start * buckets / end;+            const stop = t.stop * buckets / end;+            if (Math.floor(start) === Math.floor(stop))+                xs[Math.floor(start)] += stop - start;+            else {+                for (let j = Math.ceil(start); j < Math.floor(stop); j++)+                    xs[j]++;+                xs[Math.floor(start)] += Math.ceil(start) - start;+                xs[Math.floor(stop)] += stop - Math.floor(stop);+            }+        }+    }+    return ans;+}+function reportCmdTable(profile, search) {+    const columns = [{ field: "name", label: "Name", width: 200 },+        { field: "count", label: "Count", width: 65, alignRight: true, show: showInt },+        { field: "total", label: "Total", width: 75, alignRight: true, show: showTime },+        { field: "average", label: "Average", width: 75, alignRight: true, show: showTime },+        { field: "max", label: "Max", width: 75, alignRight: true, show: showTime }+    ];+    return newTable(columns, search.map(cmdData), "total", true);+}+function cmdData(search) {+    const res = {};+    search.forEachProfile(p => {+        for (const t of p.traces) {+            const time = t.stop - t.start;+            if (t.command === "")+                continue; // do nothing+            else if (!(t.command in res))+                res[t.command] = { count: 1, total: time, max: time };+            else {+                const ans = res[t.command];+                ans.count++;+                ans.total += time;+                ans.max = Math.max(ans.max, time);+            }+        }+    });+    const res2 = [];+    for (const i in res)+        res2.push({ name: i, average: res[i].total / res[i].count, ...res[i] });+    return res2;+}+function reportDetails(profile, search) {+    const result = React.createElement("div", { class: "details" });+    const self = new Prop(0);+    search.event(xs => self.set(xs.mapProfile((p, _) => p.index).maximum()));+    const f = (i) => React.createElement("a", { onclick: () => self.set(i) }, profile[i].name);+    self.event(i => {+        const p = profile[i];+        const content = React.createElement("ul", null,+            React.createElement("li", null,+                React.createElement("b", null, "Name:"),+                " ",+                p.name),+            React.createElement("li", null,+                React.createElement("b", null, "Built:"),+                " ",+                showRun(p.built)),+            React.createElement("li", null,+                React.createElement("b", null, "Changed:"),+                " ",+                showRun(p.changed)),+            React.createElement("li", null,+                React.createElement("b", null, "Execution time:"),+                showTime(p.execution)),+            React.createElement("li", null,+                React.createElement("b", null, "Traced commands:"),+                React.createElement("ol", null, p.traces.map(t => React.createElement("li", null,+                    t.command,+                    " took ",+                    showTime(t.stop - t.start))))),+            React.createElement("li", null,+                React.createElement("b", null, "Dependencies:"),+                React.createElement("ol", null, p.depends.map(ds => React.createElement("li", null,+                    React.createElement("ul", null, ds.map(d => React.createElement("li", null, f(d)))))))),+            React.createElement("li", null,+                React.createElement("b", null, "Things that depend on me:"),+                React.createElement("ul", null, p.rdepends.map(d => React.createElement("li", null, f(d))))));+        $(result).empty().append(content);+    });+    return result;+}+function reportParallelism(profile) {+    // now simulate for -j1 .. -j24+    const plotData = [{ label: "Realistic (based on current dependencies)", data: [], color: "#3131a7" },+        { label: "Ideal (if no dependencies and perfect speedup)", data: [], color: "green" },+        { label: "Gap", data: [], color: "orange" }+    ];+    let threads1;+    for (let threads = 1; threads <= 24; threads++) {+        const taken = simulateThreads(profile, threads)[0];+        if (threads === 1)+            threads1 = taken;+        plotData[0].data.push([threads, taken]);+        plotData[1].data.push([threads, threads1 / threads]);+        plotData[2].data.push([threads, Math.max(0, taken - (threads1 / threads))]);+    }+    const plot = React.createElement("div", { style: "width:100%; height:100%;" });+    bindPlot(plot, new Prop(plotData), {+        xaxis: { tickDecimals: 0 },+        yaxis: { min: 0, tickFormatter: showTime }+    });+    return React.createElement("table", { class: "fill" },+        React.createElement("tr", null,+            React.createElement("td", { style: "text-align:center;" },+                React.createElement("h2", null, "Time to build at different number of threads"))),+        React.createElement("tr", null,+            React.createElement("td", { height: "100%" }, plot)),+        React.createElement("tr", null,+            React.createElement("td", { style: "text-align:center;" }, "Number of threads available.")));+}+// Simulate running N threads over the profile, return:+// [total time take, point at which each entry kicked off]+function simulateThreads(profile, threads) {+    // How far are we through this simulation+    let timestamp = 0;+    // Who is currently running, with the highest seconds FIRST+    const running = [];+    const started = [];+    // Things that are done+    const ready = profile.filter(x => x.depends.length === 0);+    const waiting = profile.map(x => x.depends.concatLength()); // number I am waiting on before I am done+    function runningWait() {+        const [ind, time] = running.pop();+        timestamp = time;+        for (const d of profile[ind].rdepends) {+            waiting[d]--;+            if (waiting[d] === 0)+                ready.push(profile[d]);+        }+    }+    while (true) {+        // Queue up as many people as we can+        while (running.length < threads && ready.length > 0) {+            const p = ready.pop();+            started[p.index] = timestamp;+            running.insertSorted([p.index, timestamp + p.execution], compareSndRev);+        }+        if (running.length === 0) {+            if (waiting.maximum(0) > 0)+                throw new Error("Failed to run all tasks");+            return [timestamp, started];+        }+        runningWait();+    }+}+function reportRebuild(profile, search) {+    const depth = [];+    for (const p of profile) {+        depth[p.index] = p.depends.flat().map(d => depth[d] + 1).maximum(0);+    }+    const ind = search.get().mapProfile((p, _) => p.index).sortOn(i => -depth[i])[0];+    const p = profile[ind];+    function f(p) {+        const res = [];+        while (p.depends.length !== 0) {+            const ds = p.depends.flat().sortOn(i => -depth[i]);+            res.push(React.createElement("li", null,+                React.createElement("select", { style: "width:400px;" }, ds.slice(0, 1).map(x => React.createElement("option", null, profile[x].name)))));+            p = profile[ds[0]];+        }+        return res;+    }+    return React.createElement("div", null,+        React.createElement("h2", null, "Why did it rebuild?"),+        React.createElement("p", null,+            "Rule ",+            p.name + " " + (p.built === 0 ? "rebuild in the last run" : "did not rebuild")),+        React.createElement("ul", null, f(p)));+}+function reportRuleTable(profile, search) {+    const [etimes, wtimes] = calcEWTimes(profile, 24);+    const columns = [{ field: "name", label: "Name", width: 400 },+        { field: "count", label: "Count", width: 65, alignRight: true, show: showInt },+        { field: "leaf", label: "Leaf", width: 60, alignRight: true },+        { field: "run", label: "Run", width: 50, alignRight: true },+        { field: "changed", label: "Change", width: 60, alignRight: true },+        { field: "time", label: "Time", width: 75, alignRight: true, show: showTime },+        { field: "etime", label: "ETime", width: 75, alignRight: true, show: showTime },+        { field: "wtime", label: "WTime", width: 75, alignRight: true, show: showTime },+        { field: "untraced", label: "Untraced", width: 100, alignRight: true, show: showTime }+    ];+    return newTable(columns, search.map(s => ruleData(etimes, wtimes, s)), "time", true);+}+// Calculate the exclusive time of each rule at some number of threads+function calcEWTimes(profile, threads) {+    const [_, started] = simulateThreads(profile, threads);+    const starts = started.map((s, i) => pair(i, s)).sort(compareSnd);+    const costs = starts.map(([ind, start], i) => {+        // find out who else runs before I finish+        const execution = profile[ind].execution;+        const end = start + execution;+        let overlap = 0; // how much time I am overlapped for+        let exclusive = 0; // how much time I am the only runner+        let finisher = start; // the first overlapping person to finish+        for (let j = i + 1; j < starts.length; j++) {+            const [jInd, jStarts] = starts[j];+            if (jStarts > end)+                break;+            overlap += Math.min(end - jStarts, profile[jInd].execution);+            exclusive += Math.max(0, Math.min(jStarts, end) - finisher);+            finisher = Math.max(finisher, jStarts + profile[jInd].execution);+        }+        exclusive += Math.max(0, end - finisher);+        return triple(ind, execution === 0 ? 0 : execution * (execution / (execution + overlap)), exclusive);+    });+    const etimes = [];+    const wtimes = [];+    for (const [ind, etime, wtime] of costs) {+        etimes[ind] = etime;+        wtimes[ind] = wtime;+    }+    return [etimes, wtimes];+}+function ruleData(etimes, wtimes, search) {+    return search.mapProfiles((ps, name) => ({+        name,+        count: ps.length,+        leaf: ps.every(p => p.depends.length === 0),+        run: ps.map(p => p.built).minimum(),+        changed: ps.some(p => p.built === p.changed),+        time: ps.map(p => p.execution).sum(),+        etime: ps.map(p => etimes[p.index]).sum(),+        wtime: ps.map(p => wtimes[p.index]).sum(),+        untraced: ps.map(untraced).sum()+    }));+}+function reportSummary(profile) {+    let countLast = 0; // number of rules run in the last run+    let highestRun = 0; // highest run you have seen (add 1 to get the count of runs)+    let sumExecution = 0; // build time in total+    let sumExecutionLast = 0; // build time in total+    let countTrace = -1;+    let countTraceLast = -1; // traced commands run+    // start both are -1 because the end command will have run in the previous step+    let maxTraceStopLast = 0; // time the last traced command stopped+    for (const p of profile) {+        sumExecution += p.execution;+        highestRun = Math.max(highestRun, p.changed); // changed is always greater or equal to built+        countTrace += p.traces.length;+        if (p.built === 0) {+            sumExecutionLast += p.execution;+            countLast++;+            countTraceLast += p.traces.length;+            if (p.traces.length > 0)+                maxTraceStopLast = Math.max(maxTraceStopLast, p.traces.last().stop);+        }+    }+    return React.createElement("div", null,+        React.createElement("h2", null, "Totals"),+        React.createElement("ul", null,+            React.createElement("li", null,+                React.createElement("b", null, "Runs:"),+                " ",+                showInt(highestRun + 1),+                " ",+                React.createElement("span", { class: "note" }, "number of times Shake has been run.")),+            React.createElement("li", null,+                React.createElement("b", null, "Rules:"),+                " ",+                showInt(profile.length),+                " (",+                showInt(countLast),+                " in last run) ",+                React.createElement("span", { class: "note" }, "number of defined rules, e.g. individual files.")),+            React.createElement("li", null,+                React.createElement("b", null, "Traced:"),+                " ",+                showInt(countTrace),+                " (",+                showInt(countTraceLast),+                " in last run)",+                React.createElement("span", { class: "note" },+                    "number of calls to ",+                    varLink("cmd"),+                    " or ",+                    varLink("traced"),+                    "."))),+        React.createElement("h2", null, "Performance"),+        React.createElement("ul", null,+            React.createElement("li", null,+                React.createElement("b", null, "Build time:"),+                " ",+                showTime(sumExecution),+                " ",+                React.createElement("span", { class: "note" }, "how long a complete build would take single threaded.")),+            React.createElement("li", null,+                React.createElement("b", null, "Last build time:"),+                " ",+                showTime(maxTraceStopLast),+                " ",+                React.createElement("span", { class: "note" }, "how long the last build take.")),+            React.createElement("li", null,+                React.createElement("b", null, "Parallelism:"),+                " ",+                (maxTraceStopLast === 0 ? 0 : sumExecutionLast / maxTraceStopLast).toFixed(2),+                " ",+                React.createElement("span", { class: "note" }, "average number of commands executing simultaneously in the last build.")),+            React.createElement("li", null,+                React.createElement("b", null, "Speculative critical path:"),+                " ",+                showTime(speculativeCriticalPath(profile)),+                " ",+                React.createElement("span", { class: "note" }, "how long it would take on infinite CPUs.")),+            React.createElement("li", null,+                React.createElement("b", null, "Precise critical path:"),+                " ",+                showTime(preciseCriticalPath(profile)),+                " ",+                React.createElement("span", { class: "note" }, "critical path not speculatively executing."))));+}+function speculativeCriticalPath(profile) {+    const criticalPath = []; // the critical path to any element+    let maxCriticalPath = 0;+    for (const p of profile) {+        let cost = 0;+        for (const ds of p.depends)+            for (const d of ds)+                cost = Math.max(cost, criticalPath[d]);+        cost += p.execution;+        maxCriticalPath = Math.max(cost, maxCriticalPath);+        criticalPath[p.index] = cost;+    }+    return maxCriticalPath;+}+/*+Calculating a precise critical path, taking into account the deep dependeny structure, is non-obvious.+Dependencies have the type [{X}], e.g:++    X = [{a,b},{c,d}]++That is r builds a and b, then after those both complete (assuming they don't change), it builds c and d,+then it is finished. Importantly, r doesn't start building c/d until after a and b have finished. This+detail extends the critical path.++To calculate the precise critical path, we simulate with the notion of demand and waiting.+*/+function preciseCriticalPath(profile) {+    const waiting = profile.map(x => x.depends.concatLength()); // number I am waiting on before I am done+    const demanded = []; // I have been demanded by someone+    const oncomplete = []; // Completion functions+    const complete = []; // Who is complete already+    const running = [];+    let timestamp = 0;+    // demand dependency set N of a rule+    function demandN(p, round) {+        for (; round < p.depends.length; round++) {+            let todo = p.depends[round].length; // Number before we continue+            const step = () => {+                todo--;+                if (todo === 0)+                    demandN(p, round + 1);+            };+            for (const d of p.depends[round]) {+                if (complete[d])+                    todo--;+                else {+                    const old = oncomplete[d];+                    oncomplete[d] = !old ? step : () => { old(); step(); };+                    demand(profile[d]);+                }+            }+            if (todo !== 0)+                break;+            // todo === 0, so continue (equivalent to calling step but tail recursive)+        }+    }+    // demand a particular rule+    function demand(p) {+        if (demanded[p.index])+            return;+        demanded[p.index] = true;+        if (waiting[p.index] === 0)+            running.insertSorted([p.index, timestamp + p.execution], compareSndRev);+        else+            demandN(p, 0);+    }+    // We don't know the targets we ask for, so we approximate by saying the ones which nothing depends on+    for (const p of profile) {+        if (p.rdepends.length === 0)+            demand(p);+    }+    while (running.length > 0) {+        const [ind, time] = running.pop();+        timestamp = time;+        complete[ind] = true;+        if (oncomplete[ind]) {+            oncomplete[ind]();+            delete oncomplete[ind];+        }+        for (const d of profile[ind].rdepends) {+            waiting[d]--;+            if (waiting[d] === 0 && demanded[d])+                running.insertSorted([d, timestamp + profile[d].execution], compareSndRev);+        }+    }+    for (let i = 0; i < profile.length; i++)+        if (!complete[i])+            throw new Error("Failed to run all tasks");+    return timestamp; }
shake.cabal view
@@ -1,118 +1,511 @@-cabal-version:      >= 1.6+cabal-version:      1.18 build-type:         Simple name:               shake-version:            0.3+version:            0.19.9 license:            BSD3 license-file:       LICENSE-category:           Development+category:           Development, Shake author:             Neil Mitchell <ndmitchell@gmail.com> maintainer:         Neil Mitchell <ndmitchell@gmail.com>-copyright:          Neil Mitchell 2011-2012+copyright:          Neil Mitchell 2011-2026 synopsis:           Build system library, like Make, but more accurate dependencies. description:     Shake is a Haskell library for writing build systems - designed as a-    replacement for make. To use Shake the user writes a Haskell program-    that imports the Shake library, defines some build rules, and calls-    shake. Thanks to do notation and infix operators, a simple Shake program+    replacement for @make@. See "Development.Shake" for an introduction,+    including an example. The homepage contains links to a user+    manual, an academic paper and further information:+    <https://shakebuild.com>+    .+    To use Shake the user writes a Haskell program+    that imports "Development.Shake", defines some build rules, and calls+    the 'Development.Shake.shakeArgs' function. Thanks to do notation and infix+    operators, a simple Shake build system     is not too dissimilar from a simple Makefile. However, as build systems     get more complex, Shake is able to take advantage of the excellent     abstraction facilities offered by Haskell and easily support much larger-    projects.-    .-    The Shake library provides all the standard features available in other+    projects. The Shake library provides all the standard features available in other     build systems, including automatic parallelism and minimal rebuilds.-    Shake provides highly accurate dependency tracking, including seamless+    Shake also provides more accurate dependency tracking, including seamless     support for generated files, and dependencies on system information-    (i.e. compiler version). Shake can produce profile reports, indicating-    which files and take longest to build, and providing an analysis of the-    parallelism.-    .-    The theory behind an old version of Shake is described in a video at-    <http://vimeo.com/15465133>, and an example is given at the top of-    "Development.Shake". Further examples are included in the Cabal tarball,-    under the @Examples@ directory.-homepage:           http://community.haskell.org/~ndm/shake/-stability:          Beta+    (e.g. compiler version).+homepage:           https://shakebuild.com+bug-reports:        https://github.com/ndmitchell/shake/issues+tested-with:        GHC==9.12, GHC==9.10, GHC==9.8, GHC==9.6, GHC==9.4, GHC==9.2, GHC==9.0, GHC==8.10, GHC==8.8+extra-doc-files:+    CHANGES.txt+    README.md+    docs/Manual.md+    docs/shake-progress.png extra-source-files:-    Examples/C/constants.c-    Examples/C/constants.h-    Examples/C/main.c-    Examples/Tar/list.txt-+    src/Paths.hs+    src/Test/C/constants.c+    src/Test/C/constants.h+    src/Test/C/main.c+    src/Test/Ninja/*.ninja+    src/Test/Ninja/*.output+    src/Test/Ninja/subdir/*.ninja+    src/Test/Progress/*.prog+    src/Test/Tar/list.txt+    src/Test/Tup/hello.c+    src/Test/Tup/newmath/root.cfg+    src/Test/Tup/newmath/square.c+    src/Test/Tup/newmath/square.h+    src/Test/Tup/root.cfg data-files:-  html/*.png-  html/*.min.js-  html/*.min.css-  html/report.html-  html/jquery-1.6.4.min.js-  html/jquery.flot.min.js-  html/shake.js+    docs/manual/build.bat+    docs/manual/Shakefile.hs+    docs/manual/build.sh+    docs/manual/constants.c+    docs/manual/constants.h+    docs/manual/main.c+    html/profile.html+    html/progress.html+    html/shake.js  source-repository head-    type:     darcs-    location: http://community.haskell.org/~ndm/darcs/shake/+    type:     git+    location: https://github.com/ndmitchell/shake.git -flag testprog+flag portable     default: False-    description: Build the test program+    manual: True+    description: Obtain FileTime using portable functions +flag cloud+    default: False+    manual: True+    description: Enable cloud build features++flag embed-files+    default: False+    manual: True+    description: Embed data files into the shake library++flag threaded+    default: True+    manual: True+    description: Build shake with the threaded RTS+ library+    default-language: Haskell2010+    hs-source-dirs:   src     build-depends:-        base == 4.*,-        old-time,-        directory,-        hashable >= 1.1.2.3 && < 1.2,+        base >= 4.9 && < 5,         binary,-        filepath,-        process,-        unordered-containers >= 0.2.1 && < 0.3,         bytestring,+        deepseq >= 1.1,+        directory >= 1.2.7.0,+        extra >= 1.6.19,+        filepath >= 1.4,+        filepattern,+        hashable >= 1.1.2.3,+        heaps >= 0.3.6.1,+        js-dgtable,+        js-flot,+        js-jquery,+        primitive,+        process >= 1.1,+        random,         time,-        transformers >= 0.2 && < 0.4,-        deepseq >= 1.1 && < 1.4+        transformers >= 0.2,+        unordered-containers >= 0.2.7,+        utf8-string >= 0.3 +    if flag(embed-files)+        cpp-options: -DFILE_EMBED+        build-depends:+            file-embed >= 0.0.11,+            template-haskell++    if flag(portable)+        cpp-options: -DPORTABLE+    else+        if !os(windows)+            build-depends: unix >= 2.5.1+    if !os(windows)+        build-depends: unix++    if flag(cloud)+        cpp-options: -DNETWORK+        build-depends: network, network-uri+     exposed-modules:         Development.Shake+        Development.Shake.Classes+        Development.Shake.Command+        Development.Shake.Config+        Development.Shake.Database         Development.Shake.FilePath+        Development.Shake.Forward+        Development.Shake.Rule+        Development.Shake.Util      other-modules:-        Development.Shake.Binary-        Development.Shake.Core-        Development.Shake.Database-        Development.Shake.Derived-        Development.Shake.Directory-        Development.Shake.File-        Development.Shake.FilePattern-        Development.Shake.Files-        Development.Shake.FileTime-        Development.Shake.Locks-        Development.Shake.Oracle-        Development.Shake.Pool-        Development.Shake.Report-        Development.Shake.Rerun-        Development.Shake.Storage-        Development.Shake.Value+        Development.Ninja.Env+        Development.Ninja.Lexer+        Development.Ninja.Parse+        Development.Ninja.Type+        Development.Shake.Internal.Args+        Development.Shake.Internal.CmdOption+        Development.Shake.Internal.CompactUI+        Development.Shake.Internal.Core.Action+        Development.Shake.Internal.Core.Build+        Development.Shake.Internal.Core.Database+        Development.Shake.Internal.History.Shared+        Development.Shake.Internal.History.Symlink+        Development.Shake.Internal.History.Bloom+        Development.Shake.Internal.History.Cloud+        Development.Shake.Internal.History.Network+        Development.Shake.Internal.History.Server+        Development.Shake.Internal.History.Serialise+        Development.Shake.Internal.History.Types+        Development.Shake.Internal.Core.Monad+        Development.Shake.Internal.Core.Pool+        Development.Shake.Internal.Core.Rules+        Development.Shake.Internal.Core.Run+        Development.Shake.Internal.Core.Storage+        Development.Shake.Internal.Core.Types+        Development.Shake.Internal.Demo+        Development.Shake.Internal.Derived+        Development.Shake.Internal.Errors+        Development.Shake.Internal.FileInfo+        Development.Shake.Internal.FileName+        Development.Shake.Internal.FilePattern+        Development.Shake.Internal.Options+        Development.Shake.Internal.Paths+        Development.Shake.Internal.Profile+        Development.Shake.Internal.Progress+        Development.Shake.Internal.Resource+        Development.Shake.Internal.Rules.Default+        Development.Shake.Internal.Rules.Directory+        Development.Shake.Internal.Rules.File+        Development.Shake.Internal.Rules.Files+        Development.Shake.Internal.Rules.Oracle+        Development.Shake.Internal.Rules.OrderOnly+        Development.Shake.Internal.Rules.Rerun+        Development.Shake.Internal.Value+        General.Bilist+        General.Binary+        General.Chunks+        General.Cleanup+        General.Fence+        General.EscCodes+        General.Extra+        General.FileLock+        General.GetOpt+        General.Ids+        General.Intern+        General.ListBuilder+        General.Makefile+        General.Pool+        General.Process+        General.Template+        General.Thread+        General.Timing+        General.TypeMap+        General.Wait         Paths_shake + executable shake-    main-is: Main.hs+    default-language: Haskell2010+    hs-source-dirs:   src+    ghc-options: -main-is Run.main -rtsopts+    if flag(threaded)+        ghc-options: -threaded "-with-rtsopts=-I0 -qg"+    main-is: Run.hs     build-depends:-        random-    if flag(testprog)-        buildable: True+        base == 4.*,+        binary,+        bytestring,+        deepseq >= 1.1,+        directory,+        extra >= 1.6.19,+        filepath,+        filepattern,+        hashable >= 1.1.2.3,+        heaps >= 0.3.6.1,+        js-dgtable,+        js-flot,+        js-jquery,+        primitive,+        process >= 1.1,+        random,+        time,+        transformers >= 0.2,+        unordered-containers >= 0.2.7,+        utf8-string >= 0.3++    if flag(embed-files)+        cpp-options: -DFILE_EMBED+        build-depends:+            file-embed >= 0.0.11,+            template-haskell++    if flag(portable)+        cpp-options: -DPORTABLE     else-        buildable: False+        if !os(windows)+            build-depends: unix >= 2.5.1+    if !os(windows)+        build-depends: unix +    if flag(cloud)+        cpp-options: -DNETWORK+        build-depends: network, network-uri++    if impl(ghc < 8.0)+        build-depends: semigroups >= 0.18+     other-modules:-        Examples.Util-        Examples.C.Main-        Examples.Self.Main-        Examples.Tar.Main-        Examples.Test.Basic-        Examples.Test.Directory-        Examples.Test.Errors-        Examples.Test.FilePath-        Examples.Test.Files-        Examples.Test.Pool-        Examples.Test.Random-        Examples.Test.Resources+        Development.Ninja.All+        Development.Ninja.Env+        Development.Ninja.Lexer+        Development.Ninja.Parse+        Development.Ninja.Type+        Development.Shake+        Development.Shake.Classes+        Development.Shake.Command+        Development.Shake.Database+        Development.Shake.FilePath+        Development.Shake.Internal.Args+        Development.Shake.Internal.CmdOption+        Development.Shake.Internal.CompactUI+        Development.Shake.Internal.Core.Action+        Development.Shake.Internal.Core.Build+        Development.Shake.Internal.Core.Database+        Development.Shake.Internal.History.Shared+        Development.Shake.Internal.History.Symlink+        Development.Shake.Internal.History.Bloom+        Development.Shake.Internal.History.Cloud+        Development.Shake.Internal.History.Network+        Development.Shake.Internal.History.Server+        Development.Shake.Internal.History.Serialise+        Development.Shake.Internal.History.Types+        Development.Shake.Internal.Core.Monad+        Development.Shake.Internal.Core.Pool+        Development.Shake.Internal.Core.Rules+        Development.Shake.Internal.Core.Run+        Development.Shake.Internal.Core.Storage+        Development.Shake.Internal.Core.Types+        Development.Shake.Internal.Demo+        Development.Shake.Internal.Derived+        Development.Shake.Internal.Errors+        Development.Shake.Internal.FileInfo+        Development.Shake.Internal.FileName+        Development.Shake.Internal.FilePattern+        Development.Shake.Internal.Options+        Development.Shake.Internal.Paths+        Development.Shake.Internal.Profile+        Development.Shake.Internal.Progress+        Development.Shake.Internal.Resource+        Development.Shake.Internal.Rules.Default+        Development.Shake.Internal.Rules.Directory+        Development.Shake.Internal.Rules.File+        Development.Shake.Internal.Rules.Files+        Development.Shake.Internal.Rules.Oracle+        Development.Shake.Internal.Rules.OrderOnly+        Development.Shake.Internal.Rules.Rerun+        Development.Shake.Internal.Value+        General.Bilist+        General.Binary+        General.Chunks+        General.Cleanup+        General.Fence+        General.EscCodes+        General.Extra+        General.FileLock+        General.GetOpt+        General.Ids+        General.Intern+        General.ListBuilder+        General.Makefile+        General.Pool+        General.Process+        General.Template+        General.Thread+        General.Timing+        General.TypeMap+        General.Wait+        Paths_shake+++test-suite shake-test+    default-language: Haskell2010+    type: exitcode-stdio-1.0+    main-is: Test.hs+    hs-source-dirs: src+    ghc-options: -main-is Test.main -rtsopts -with-rtsopts=-K1K+    if flag(threaded)+        ghc-options: -threaded++    build-depends:+        base == 4.*,+        binary,+        bytestring,+        deepseq >= 1.1,+        directory,+        extra >= 1.6.19,+        filepath,+        filepattern,+        hashable >= 1.1.2.3,+        heaps >= 0.3.6.1,+        js-dgtable,+        js-flot,+        js-jquery,+        primitive,+        process >= 1.1,+        QuickCheck >= 2.0,+        random,+        time,+        transformers >= 0.2,+        unordered-containers >= 0.2.7,+        utf8-string >= 0.3++    if flag(embed-files)+        cpp-options: -DFILE_EMBED+        build-depends:+            file-embed >= 0.0.11,+            template-haskell++    if flag(portable)+        cpp-options: -DPORTABLE+    else+        if !os(windows)+            build-depends: unix >= 2.5.1+    if !os(windows)+        build-depends: unix++    if flag(cloud)+        cpp-options: -DNETWORK+        build-depends: network, network-uri++    if impl(ghc < 8.0)+        build-depends: semigroups >= 0.18++    other-modules:+        Development.Ninja.All+        Development.Ninja.Env+        Development.Ninja.Lexer+        Development.Ninja.Parse+        Development.Ninja.Type+        Development.Shake+        Development.Shake.Classes+        Development.Shake.Command+        Development.Shake.Config+        Development.Shake.Database+        Development.Shake.FilePath+        Development.Shake.Forward+        Development.Shake.Internal.Args+        Development.Shake.Internal.CmdOption+        Development.Shake.Internal.CompactUI+        Development.Shake.Internal.Core.Action+        Development.Shake.Internal.Core.Build+        Development.Shake.Internal.Core.Database+        Development.Shake.Internal.History.Shared+        Development.Shake.Internal.History.Symlink+        Development.Shake.Internal.History.Bloom+        Development.Shake.Internal.History.Cloud+        Development.Shake.Internal.History.Network+        Development.Shake.Internal.History.Server+        Development.Shake.Internal.History.Serialise+        Development.Shake.Internal.History.Types+        Development.Shake.Internal.Core.Monad+        Development.Shake.Internal.Core.Pool+        Development.Shake.Internal.Core.Rules+        Development.Shake.Internal.Core.Run+        Development.Shake.Internal.Core.Storage+        Development.Shake.Internal.Core.Types+        Development.Shake.Internal.Demo+        Development.Shake.Internal.Derived+        Development.Shake.Internal.Errors+        Development.Shake.Internal.FileInfo+        Development.Shake.Internal.FileName+        Development.Shake.Internal.FilePattern+        Development.Shake.Internal.Options+        Development.Shake.Internal.Paths+        Development.Shake.Internal.Profile+        Development.Shake.Internal.Progress+        Development.Shake.Internal.Resource+        Development.Shake.Internal.Rules.Default+        Development.Shake.Internal.Rules.Directory+        Development.Shake.Internal.Rules.File+        Development.Shake.Internal.Rules.Files+        Development.Shake.Internal.Rules.Oracle+        Development.Shake.Internal.Rules.OrderOnly+        Development.Shake.Internal.Rules.Rerun+        Development.Shake.Internal.Value+        Development.Shake.Rule+        Development.Shake.Util+        General.Bilist+        General.Binary+        General.Chunks+        General.Cleanup+        General.Fence+        General.EscCodes+        General.Extra+        General.FileLock+        General.GetOpt+        General.Ids+        General.Intern+        General.ListBuilder+        General.Makefile+        General.Pool+        General.Process+        General.Template+        General.Thread+        General.Timing+        General.TypeMap+        General.Wait+        Paths_shake+        Run+        Test.Basic+        Test.Batch+        Test.Benchmark+        Test.Builtin+        Test.BuiltinOverride+        Test.C+        Test.Cache+        Test.Cleanup+        Test.CloseFileHandles+        Test.Command+        Test.Config+        Test.Database+        Test.Digest+        Test.Directory+        Test.Docs+        Test.Errors+        Test.Existence+        Test.FileLock+        Test.FilePath+        Test.FilePattern+        Test.Files+        Test.Forward+        Test.History+        Test.Journal+        Test.Lint+        Test.Live+        Test.Manual+        Test.Match+        Test.Monad+        Test.Ninja+        Test.Oracle+        Test.OrderOnly+        Test.Parallel+        Test.Pool+        Test.Progress+        Test.Random+        Test.Rebuild+        Test.Reschedule+        Test.Resources+        Test.Self+        Test.SelfMake+        Test.Tar+        Test.Targets+        Test.Thread+        Test.Tup+        Test.Type+        Test.Unicode+        Test.Util+        Test.Verbosity+        Test.Version
+ src/Development/Ninja/All.hs view
@@ -0,0 +1,299 @@+{-# LANGUAGE RecordWildCards, ViewPatterns, ScopedTypeVariables, TupleSections #-}++module Development.Ninja.All(runNinja) where++import Development.Ninja.Env+import Development.Ninja.Type+import Development.Ninja.Parse+import Development.Shake hiding (addEnv)+import Development.Shake.Classes+import qualified Data.ByteString as BS8+import qualified Data.ByteString.Char8 as BS++import System.Directory+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import Data.Tuple.Extra+import Control.Exception.Extra+import Control.Monad+import Data.Maybe+import Data.Char+import Data.List.Extra+import System.Info.Extra++-- Internal imports+import General.Extra(removeFile_, headErr)+import General.Timing(addTiming)+import General.Makefile(parseMakefile)+import Development.Shake.Internal.FileName(filepathNormalise, fileNameFromString)+import Development.Shake.Internal.FileInfo(getFileInfo)+import Development.Shake.Internal.Errors(throwM, errorStructured)+import Development.Shake.Internal.Rules.File(needBS, neededBS)+import Development.Shake.Internal.Rules.OrderOnly(orderOnlyBS)+++-- | Given the Ninja source file, a list of file arguments, a tool name.+--   Return a bool if you should restart and the rules.+runNinja :: IO () -> FilePath -> [String] -> Maybe String -> IO (Maybe (Rules ()))+runNinja _ file args (Just "compdb") = do+    dir <- getCurrentDirectory+    Ninja{..} <- parse file =<< newEnv+    rules<- pure $ Map.fromList [r | r <- rules, BS.unpack (fst r) `elem` args]+    -- the build items are generated in reverse order, hence the reverse+    let xs = [(a,b,file,rule) | (a,b@Build{..}) <- reverse $ multiples ++ map (first pure) singles+                              , Just rule <- [Map.lookup ruleName rules], file:_ <- [depsNormal]]+    xs <- forM xs $ \(out,Build{..},file,Rule{..}) -> do+        -- the order of adding new environment variables matters+        env <- scopeEnv env+        addEnv env (BS.pack "out") (BS.unwords $ map quote out)+        addEnv env (BS.pack "in") (BS.unwords $ map quote depsNormal)+        addEnv env (BS.pack "in_newline") (BS.unlines depsNormal)+        forM_ buildBind $ \(a,b) -> addEnv env a b+        addBinds env ruleBind+        commandline <- fmap BS.unpack $ askVar env $ BS.pack "command"+        pure $ CompDb dir commandline $ BS.unpack file+    putStr $ printCompDb xs+    pure Nothing++runNinja _ _ _ (Just x) = errorIO $ "Unknown tool argument, expected 'compdb', got " ++ x++runNinja restart file args Nothing = do+    addTiming "Ninja parse"+    ninja@Ninja{..} <- parse file =<< newEnv+    pure $ Just $ do+        phonys<- pure $ Map.fromList phonys+        needDeps<- pure $ needDeps ninja phonys -- partial application+        singles<- pure $ Map.fromList $ map (first filepathNormalise) singles+        multiples<- pure $ Map.fromList [(x,(xs,b)) | (xs,b) <- map (first $ map filepathNormalise) multiples, x <- xs]+        rules<- pure $ Map.fromList rules+        pools <- fmap Map.fromList $ forM ((BS.pack "console",1):pools) $ \(name,depth) ->+            (name,) <$> newResource (BS.unpack name) depth++        action $ do+            -- build the .ninja files, if they change, restart the build+            before <- liftIO $ mapM (getFileInfo False . fileNameFromString) sources+            need sources+            after <- liftIO $ mapM (getFileInfo False . fileNameFromString) sources+            if before /= after then+                runAfter restart+             else+                needBS $ concatMap (resolvePhony phonys) $+                    if not $ null args then map BS.pack args+                    else if not $ null defaults then defaults+                    else Map.keys singles ++ Map.keys multiples++        (\x -> map BS.unpack . fst <$> Map.lookup (BS.pack x) multiples) &?> \out -> let out2 = map BS.pack out in+            build needDeps phonys rules pools out2 $ snd $ multiples Map.! headErr out2++        (flip Map.member singles . BS.pack) ?> \out -> let out2 = BS.pack out in+            build needDeps phonys rules pools [out2] $ singles Map.! out2+++resolvePhony :: Map.HashMap Str [Str] -> Str -> [Str]+resolvePhony mp = f $ Left 100+    where+        f (Left 0) x = f (Right []) x+        f (Right xs) x | x `elem` xs = error $ "Ninja recursive phony involving " ++ BS.unpack x+        f a x = case Map.lookup x mp of+            Nothing -> [x]+            Just xs -> concatMap (f $ either (Left . subtract 1) (Right . (x:)) a) xs+++quote :: Str -> Str+quote x | BS.any isSpace x = let q = BS.singleton '\"' in BS.concat [q,x,q]+        | otherwise = x+++build :: (Build -> [Str] -> Action ()) -> Map.HashMap Str [Str] -> Map.HashMap Str Rule -> Map.HashMap Str Resource -> [Str] -> Build -> Action ()+build needDeps phonys rules pools out build@Build{..} = do+    needBS $ concatMap (resolvePhony phonys) $ depsNormal ++ depsImplicit+    orderOnlyBS $ concatMap (resolvePhony phonys) depsOrderOnly+    case Map.lookup ruleName rules of+        Nothing -> liftIO $ errorIO $ "Ninja rule named " ++ BS.unpack ruleName ++ " is missing, required to build " ++ BS.unpack (BS.unwords out)+        Just Rule{..} -> do+            env <- liftIO $ scopeEnv env+            liftIO $ do+                -- the order of adding new environment variables matters+                addEnv env (BS.pack "out") (BS.unwords $ map quote out)+                addEnv env (BS.pack "in") (BS.unwords $ map quote depsNormal)+                addEnv env (BS.pack "in_newline") (BS.unlines depsNormal)+                forM_ buildBind $ \(a,b) -> addEnv env a b+                addBinds env ruleBind++            applyRspfile env $ do+                commandline <- liftIO $ fmap BS.unpack $ askVar env $ BS.pack "command"+                depfile <- liftIO $ fmap BS.unpack $ askVar env $ BS.pack "depfile"+                deps <- liftIO $ fmap BS.unpack $ askVar env $ BS.pack "deps"+                description <- liftIO $ fmap BS.unpack $ askVar env $ BS.pack "description"+                pool <- liftIO $ askVar env $ BS.pack "pool"++                let withPool act = case Map.lookup pool pools of+                        _ | BS.null pool -> act+                        Nothing -> liftIO $ errorIO $ "Ninja pool named " ++ BS.unpack pool ++ " not found, required to build " ++ BS.unpack (BS.unwords out)+                        Just r -> withResource r 1 act++                when (description /= "") $ putInfo description+                let (cmdOpts, cmdProg, cmdArgs) = toCommand commandline+                if deps == "msvc" then do+                    Stdout stdout <- withPool $ command cmdOpts cmdProg cmdArgs+                    prefix <- liftIO $ fmap (fromMaybe $ BS.pack "Note: including file: ") $+                                       askEnv env $ BS.pack "msvc_deps_prefix"+                    needDeps build $ parseShowIncludes prefix $ BS.pack stdout+                 else+                    withPool $ command_ cmdOpts cmdProg cmdArgs+                when (depfile /= "") $ do+                    when (deps /= "gcc") $ need [depfile]+                    depsrc <- liftIO $ BS.readFile depfile+                    needDeps build $ concatMap snd $ parseMakefile depsrc+                    -- correct as per the Ninja spec, but breaks --skip-commands+                    -- when (deps == "gcc") $ liftIO $ removeFile depfile+++needDeps :: Ninja -> Map.HashMap Str [Str] -> Build -> [Str] -> Action ()+needDeps Ninja{..} phonysMp = \build xs -> do -- eta reduced so 'builds' is shared+    opts <- getShakeOptions+    if isNothing $ shakeLint opts then needBS xs else do+        neededBS xs+        -- now try and statically validate needed will never fail+        -- first find which dependencies are generated files+        xs<- pure $ filter (`Map.member` builds) xs+        -- now try and find them as dependencies+        -- performance note: allDependencies generates lazily, and difference consumes lazily,+        -- with the property that in the common case it won't generate much of the list at all+        let bad = xs `difference` allDependencies build+        case bad of+            [] -> pure ()+            xs -> throwM $ errorStructured+                ("Lint checking error - " +++                    (if length xs == 1 then "file in deps is" else "files in deps are") +++                    " generated and not a pre-dependency")+                [("File", Just $ BS.unpack x) | x <- xs]+                ""+    where+        builds :: Map.HashMap FileStr Build+        builds = Map.fromList $ singles ++ [(x,y) | (xs,y) <- multiples, x <- xs]++        -- do list difference, assuming a small initial set, most of which occurs early in the list+        difference :: (Eq a, Hashable a) => [a] -> [a] -> [a]+        difference [] _ = []+        difference xs ys = f (Set.fromList xs) ys+            where+                f xs [] = Set.toList xs+                f xs (y:ys)+                    | y `Set.member` xs = let xs2 = Set.delete y xs in if Set.null xs2 then [] else f xs2 ys+                    | otherwise = f xs ys++        -- find all dependencies of a rule, no duplicates, with all dependencies of this rule listed first+        allDependencies :: Build -> [FileStr]+        allDependencies rule = f Set.empty [] [rule]+            where+                f _ [] [] = []+                f seen [] (x:xs) = f seen (map filepathNormalise $ concatMap (resolvePhony phonysMp) $ depsNormal x ++ depsImplicit x ++ depsOrderOnly x) xs+                f seen (x:xs) rest | x `Set.member` seen = f seen xs rest+                                   | otherwise = x : f (Set.insert x seen) xs (maybeToList (Map.lookup x builds) ++ rest)+++applyRspfile :: Env Str Str -> Action a -> Action a+applyRspfile env act = do+    rspfile <- liftIO $ fmap BS.unpack $ askVar env $ BS.pack "rspfile"+    rspfile_content <- liftIO $ askVar env $ BS.pack "rspfile_content"+    if rspfile == "" then+        act+     else+        flip actionFinally (removeFile_ rspfile) $ do+            liftIO $ BS.writeFile rspfile rspfile_content+            act+++parseShowIncludes :: Str -> Str -> [FileStr]+parseShowIncludes prefix out =+    [y | x <- BS.lines out, prefix `BS.isPrefixOf` x+       , let y = BS.dropWhile isSpace $ BS.drop (BS.length prefix) x+       , not $ isSystemInclude y]++-- Dodgy, but ported over from the original Ninja+isSystemInclude :: FileStr -> Bool+isSystemInclude x = bsProgFiles `BS.isInfixOf` tx || bsVisStudio `BS.isInfixOf` tx+    where tx = BS8.map (\c -> if c >= 97 then c - 32 else c) x+               -- optimised toUpper that only cares about letters and spaces++bsProgFiles = BS.pack "PROGRAM FILES"+bsVisStudio = BS.pack "MICROSOFT VISUAL STUDIO"+++data CompDb = CompDb+    {cdbDirectory :: String+    ,cdbCommand :: String+    ,cdbFile :: String+    }+    deriving Show++printCompDb :: [CompDb] -> String+printCompDb xs = unlines $ ["["] ++ concat (zipWithFrom f 1 xs) ++ ["]"]+    where+        n = length xs+        f i CompDb{..} =+            ["  {"+            ,"    \"directory\": " ++ g cdbDirectory ++ ","+            ,"    \"command\": " ++ g cdbCommand ++ ","+            ,"    \"file\": " ++ g cdbFile+            ,"  }" ++ (if i == n then "" else ",")]+        g = show+++toCommand :: String -> ([CmdOption], String, [String])+toCommand s+    -- On POSIX, Ninja does a /bin/sh -c, and so does Haskell in Shell mode (easy).+    | not isWindows = ([Shell], s, [])+    -- On Windows, Ninja passes the string directly to CreateProcess,+    -- but Haskell applies some escaping first.+    -- We try and get back as close to the original as we can, but it's very hacky+    | length s < 8000 =+        -- Using the "cmd" program adds overhead (I measure 7ms), and a limit of 8191 characters,+        -- but is the most robust, requiring no additional escaping.+        ([Shell], s, [])+    | (cmd,s) <- word1 s, upper cmd `elem` ["CMD","CMD.EXE"], ("/c",s) <- word1 s =+        -- Given "cmd.exe /c <something>" we translate to Shell, which adds cmd.exe+        -- (looked up on the current path) and /c to the front. CMake uses this rule a lot.+        -- Adding quotes around pieces are /c goes very wrong.+        ([Shell], s, [])+    | otherwise =+        -- It's a long command line which doesn't call "cmd /c". We reverse the escaping+        -- Haskell applies, but each argument will still gain quotes around it.+        let xs = splitArgs s in ([], headDef "" xs, drop1 xs)+++data State+    = Gap -- ^ Current in the gap between words+    | Word -- ^ Currently inside a space-separated argument+    | Quot -- ^ Currently inside a quote-surrounded argument++-- | The process package contains a translate function, reproduced below. The aim is that after command line+--   parsing we should get out mostly the same answer.+splitArgs :: String -> [String]+splitArgs = f Gap+    where+        f Gap (x:xs) | isSpace x = f Gap xs+        f Gap ('\"':xs) = f Quot xs+        f Gap [] = []+        f Gap xs = f Word xs+        f Word (x:xs) | isSpace x = [] : f Gap xs+        f Quot ('\"':xs) = [] : f Gap xs+        f s ('\\':xs) | (length -> a, b) <- span (== '\\') xs = case b of+            '\"':xs | even a -> add (replicate (a `div` 2) '\\' ++ "\"") $ f s xs+                    | otherwise -> add (replicate ((a+1) `div` 2) '\\') $ f s ('\"':xs)+            xs -> add (replicate (a+1) '\\') $ f s xs+        f s (x:xs) = add [x] $ f s xs+        f _ [] = [[]]++        add a (b:c) = (a++b):c+        add a [] = [a]++{-+translate (cmd,args) = unwords $ f cmd : map f args+    where+        f x = '"' : snd (foldr escape (True,"\"") xs)+        escape '"'  (_,     str) = (True,  '\\' : '"'  : str)+        escape '\\' (True,  str) = (True,  '\\' : '\\' : str)+        escape c    (_,     str) = (False, c : str)+-}
+ src/Development/Ninja/Env.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE PatternGuards #-}++-- | A Ninja style environment, equivalent to a non-empty list of mutable hash tables.+module Development.Ninja.Env(+    Env, newEnv, scopeEnv, addEnv, askEnv, fromEnv+    ) where++import qualified Data.HashMap.Strict as Map+import Data.Hashable+import Data.IORef+++data Env k v = Env (IORef (Map.HashMap k v)) (Maybe (Env k v))++instance Show (Env k v) where show _ = "Env"+++newEnv :: IO (Env k v)+newEnv = do ref <- newIORef Map.empty; pure $ Env ref Nothing+++scopeEnv :: Env k v -> IO (Env k v)+scopeEnv e = do ref <- newIORef Map.empty; pure $ Env ref $ Just e+++addEnv :: (Eq k, Hashable k) => Env k v -> k -> v -> IO ()+addEnv (Env ref _) k v = modifyIORef ref $ Map.insert k v+++askEnv :: (Eq k, Hashable k) => Env k v -> k -> IO (Maybe v)+askEnv (Env ref e) k = do+    mp <- readIORef ref+    case Map.lookup k mp of+        Just v -> pure $ Just v+        Nothing | Just e <- e -> askEnv e k+        _ -> pure Nothing++fromEnv :: Env k v -> IO (Map.HashMap k v)+fromEnv (Env ref _) = readIORef ref
+ src/Development/Ninja/Lexer.hs view
@@ -0,0 +1,241 @@+{-# LANGUAGE PatternGuards #-}+-- {-# OPTIONS_GHC -O2 #-} -- fails with GHC 7.10+-- {-# OPTIONS_GHC -ddump-simpl #-}++-- | Lexing is a slow point, the code below is optimised+module Development.Ninja.Lexer(Lexeme(..), lexerFile) where++import Data.Tuple.Extra+import Data.Char+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Unsafe as BS+import Development.Ninja.Type+import qualified Data.ByteString.Internal as Internal+import System.IO.Unsafe+import Data.Word+import Foreign.Ptr+import Foreign.Storable+import GHC.Exts++---------------------------------------------------------------------+-- LIBRARY BITS++newtype Str0 = Str0 Str -- null terminated++type S = Ptr Word8++char :: S -> Char+char x = Internal.w2c $ unsafePerformIO $ peek x++next :: S -> S+next x = x `plusPtr` 1++{-# INLINE dropWhile0 #-}+dropWhile0 :: (Char -> Bool) -> Str0 -> Str0+dropWhile0 f x = snd $ span0 f x++{-# INLINE span0 #-}+span0 :: (Char -> Bool) -> Str0 -> (Str, Str0)+span0 f = break0 (not . f)++{-# INLINE break0 #-}+break0 :: (Char -> Bool) -> Str0 -> (Str, Str0)+break0 f (Str0 bs) = (BS.unsafeTake i bs, Str0 $ BS.unsafeDrop i bs)+    where+        i = unsafePerformIO $ BS.unsafeUseAsCString bs $ \ptr -> do+            let start = castPtr ptr :: S+            let end = go start+            pure $! Ptr end `minusPtr` start++        go s@(Ptr a) | c == '\0' || f c = a+                     | otherwise = go (next s)+            where c = char s++{-# INLINE break00 #-}+-- The predicate must return true for '\0'+break00 :: (Char -> Bool) -> Str0 -> (Str, Str0)+break00 f (Str0 bs) = (BS.unsafeTake i bs, Str0 $ BS.unsafeDrop i bs)+    where+        i = unsafePerformIO $ BS.unsafeUseAsCString bs $ \ptr -> do+            let start = castPtr ptr :: S+            let end = go start+            pure $! Ptr end `minusPtr` start++        go s@(Ptr a) | f c = a+                     | otherwise = go (next s)+            where c = char s++head0 :: Str0 -> Char+head0 (Str0 x) = Internal.w2c $ BS.unsafeHead x++tail0 :: Str0 -> Str0+tail0 (Str0 x) = Str0 $ BS.unsafeTail x++list0 :: Str0 -> (Char, Str0)+list0 x = (head0 x, tail0 x)++take0 :: Int -> Str0 -> Str+take0 i (Str0 x) = BS.takeWhile (/= '\0') $ BS.take i x+++---------------------------------------------------------------------+-- ACTUAL LEXER++-- Lex each line separately, rather than each lexeme+data Lexeme+    = LexBind Str Expr -- [indent]foo = bar+    | LexBuild [Expr] Str [Expr] -- build foo: bar | baz || qux (| and || are represented as Expr)+    | LexInclude Expr -- include file+    | LexSubninja Expr -- include file+    | LexRule Str -- rule name+    | LexPool Str -- pool name+    | LexDefault [Expr] -- default foo bar+    | LexDefine Str Expr -- foo = bar+      deriving Show++isVar, isVarDot :: Char -> Bool+isVar x = x == '-' || x == '_' || isAsciiLower x || isAsciiUpper x || isDigit x+isVarDot x = x == '.' || isVar x++endsDollar :: Str -> Bool+endsDollar = BS.isSuffixOf (BS.singleton '$')++dropN :: Str0 -> Str0+dropN x = if head0 x == '\n' then tail0 x else x++dropSpace :: Str0 -> Str0+dropSpace = dropWhile0 (== ' ')+++lexerFile :: Maybe FilePath -> IO [Lexeme]+lexerFile file = lexer <$> maybe BS.getContents BS.readFile file++lexer :: Str -> [Lexeme]+lexer x = lexerLoop $ Str0 $ x `BS.append` BS.pack "\n\n\0"++lexerLoop :: Str0 -> [Lexeme]+lexerLoop c_x | (c,x) <- list0 c_x = case c of+    '\r' -> lexerLoop x+    '\n' -> lexerLoop x+    ' ' -> lexBind $ dropSpace x+    '#' -> lexerLoop $ dropWhile0 (/= '\n') x+    'b' | Just x <- strip "uild " x -> lexBuild x+    'r' | Just x <- strip "ule " x -> lexRule x+    'd' | Just x <- strip "efault " x -> lexDefault x+    'p' | Just x <- strip "ool " x -> lexPool x+    'i' | Just x <- strip "nclude " x -> lexInclude x+    's' | Just x <- strip "ubninja " x -> lexSubninja x+    '\0' -> []+    _ -> lexDefine c_x+    where+        strip str (Str0 x) = if b `BS.isPrefixOf` x then Just $ dropSpace $ Str0 $ BS.drop (BS.length b) x else Nothing+            where b = BS.pack str++lexBind :: Str0 -> [Lexeme]+lexBind c_x | (c,x) <- list0 c_x = case c of+    '\r' -> lexerLoop x+    '\n' -> lexerLoop x+    '#' -> lexerLoop $ dropWhile0 (/= '\n') x+    '\0' -> []+    _ -> lexxBind LexBind c_x++lexBuild :: Str0 -> [Lexeme]+lexBuild x+    | (outputs,x) <- lexxExprs True x+    , (rule,x) <- span0 isVarDot $ jumpCont $ dropSpace x+    , (deps,x) <- lexxExprs False $ dropSpace x+    = LexBuild outputs rule deps : lexerLoop x++lexDefault :: Str0 -> [Lexeme]+lexDefault x+    | (files,x) <- lexxExprs False x+    = LexDefault files : lexerLoop x++lexRule, lexPool, lexInclude, lexSubninja, lexDefine :: Str0 -> [Lexeme]+lexRule = lexxName LexRule+lexPool = lexxName LexPool+lexInclude = lexxFile LexInclude+lexSubninja = lexxFile LexSubninja+lexDefine = lexxBind LexDefine++lexxBind :: (Str -> Expr -> Lexeme) -> Str0 -> [Lexeme]+lexxBind ctor x+    | (var,x) <- span0 isVarDot x+    , ('=',x) <- list0 $ jumpCont $ dropSpace x+    , (exp,x) <- lexxExpr False False $ jumpCont $ dropSpace x+    = ctor var exp : lexerLoop x+lexxBind _ x = error $ "Ninja parse failed when parsing binding, " ++ show (take0 100 x)++lexxFile :: (Expr -> Lexeme) -> Str0 -> [Lexeme]+lexxFile ctor x+    | (exp,rest) <- lexxExpr False False $ dropSpace x+    = ctor exp : lexerLoop rest++lexxName :: (Str -> Lexeme) -> Str0 -> [Lexeme]+lexxName ctor x+    | (name,rest) <- splitLineCont x+    = ctor name : lexerLoop rest+++lexxExprs :: Bool -> Str0 -> ([Expr], Str0)+lexxExprs stopColon x = case lexxExpr stopColon True x of+    (a,c_x) | c <- head0 c_x, x <- tail0 c_x -> case c of+        ' ' -> add a $ lexxExprs stopColon $ dropSpace x+        ':' | stopColon -> new a x+        _ | stopColon -> error "Ninja parsing, expected a colon"+        '\r' -> new a $ dropN x+        '\n' -> new a x+        '\0' -> new a c_x+        _ -> error "Ninja parsing, unexpected expression"+    where+        new a x = add a ([], x)+        add (Exprs []) x = x+        add a (as,x) = (a:as,x)+++{-# NOINLINE lexxExpr #-}+lexxExpr :: Bool -> Bool -> Str0 -> (Expr, Str0) -- snd will start with one of " :\n\r" or be empty+lexxExpr stopColon stopSpace = first exprs . f+    where+        exprs [x] = x+        exprs xs = Exprs xs++        special = case (stopColon, stopSpace) of+            (True , True ) -> \x -> x <= ':' && (x == ':' || x == ' ' || x == '$' || x == '\r' || x == '\n' || x == '\0')+            (True , False) -> \x -> x <= ':' && (x == ':'             || x == '$' || x == '\r' || x == '\n' || x == '\0')+            (False, True ) -> \x -> x <= '$' && (            x == ' ' || x == '$' || x == '\r' || x == '\n' || x == '\0')+            (False, False) -> \x -> x <= '$' && (                        x == '$' || x == '\r' || x == '\n' || x == '\0')+        f x = case break00 special x of (a,x) -> if BS.null a then g x else Lit a $: g x++        x $: (xs,y) = (x:xs,y)++        g x | head0 x /= '$' = ([], x)+        g x | c_x <- tail0 x, (c,x) <- list0 c_x = case c of+            '$' -> Lit (BS.singleton '$') $: f x+            ' ' -> Lit (BS.singleton ' ') $: f x+            ':' -> Lit (BS.singleton ':') $: f x+            '\n' -> f $ dropSpace x+            '\r' -> f $ dropSpace $ dropN x+            '{' | (name,x) <- span0 isVarDot x, not $ BS.null name, ('}',x) <- list0 x -> Var name $: f x+            _ | (name,x) <- span0 isVar c_x, not $ BS.null name -> Var name $: f x+            _ -> error "Ninja parsing, unexpect $ followed by unexpected stuff"++jumpCont :: Str0 -> Str0+jumpCont o+    | '$' <- head0 o+    , let x = tail0 o+    = case head0 x of+        '\n' -> dropSpace $ tail0 x+        '\r' -> dropSpace $ dropN $ tail0 x+        _ -> o+    | otherwise = o++splitLineCont :: Str0 -> (Str, Str0)+splitLineCont x = first BS.concat $ f x+    where+        f x = if not $ endsDollar a then ([a], b) else let (c,d) = f $ dropSpace b in (BS.init a : c, d)+            where (a,b) = splitLineCR x++splitLineCR :: Str0 -> (Str, Str0)+splitLineCR x = if BS.singleton '\r' `BS.isSuffixOf` a then (BS.init a, dropN b) else (a, dropN b)+    where (a,b) = break0 (== '\n') x
+ src/Development/Ninja/Parse.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE RecordWildCards, TupleSections #-}++module Development.Ninja.Parse(parse) where++import qualified Data.ByteString.Char8 as BS+import Development.Ninja.Env+import Development.Ninja.Type+import Development.Ninja.Lexer+import Control.Monad+import General.Extra+++parse :: FilePath -> Env Str Str -> IO Ninja+parse file env = parseFile file env newNinja+++parseFile :: FilePath -> Env Str Str -> Ninja -> IO Ninja+parseFile file env ninja = do+    lexes <- lexerFile $ if file == "-" then Nothing else Just file+    foldM (applyStmt env) ninja{sources=file:sources ninja} $ withBinds lexes++withBinds :: [Lexeme] -> [(Lexeme, [(Str,Expr)])]+withBinds [] = []+withBinds (x:xs) = (x,a) : withBinds b+    where+        (a,b) = f xs+        f (LexBind a b : rest) = let (as,bs) = f rest in ((a,b):as, bs)+        f xs = ([], xs)+++applyStmt :: Env Str Str -> Ninja -> (Lexeme, [(Str,Expr)]) -> IO Ninja+applyStmt env ninja@Ninja{..} (key, binds) = case key of+    LexBuild outputs rule deps -> do+        outputs <- mapM (askExpr env) outputs+        deps <- mapM (askExpr env) deps+        binds <- mapM (\(a,b) -> (a,) <$> askExpr env b) binds+        let (normal,implicit,orderOnly) = splitDeps deps+        let build = Build rule env normal implicit orderOnly binds+        pure $+            if rule == BS.pack "phony" then ninja{phonys = [(x, normal ++ implicit ++ orderOnly) | x <- outputs] ++ phonys}+            else if length outputs == 1 then ninja{singles = (headErr outputs, build) : singles}+            else ninja{multiples = (outputs, build) : multiples}+    LexRule name ->+        pure ninja{rules = (name, Rule binds) : rules}+    LexDefault xs -> do+        xs <- mapM (askExpr env) xs+        pure ninja{defaults = xs ++ defaults}+    LexPool name -> do+        depth <- getDepth env binds+        pure ninja{pools = (name, depth) : pools}+    LexInclude expr -> do+        file <- askExpr env expr+        parseFile (BS.unpack file) env ninja+    LexSubninja expr -> do+        file <- askExpr env expr+        e <- scopeEnv env+        parseFile (BS.unpack file) e ninja+    LexDefine a b -> do+        addBind env a b+        pure ninja+    LexBind a _ ->+        error $ "Ninja parsing, unexpected binding defining " ++ BS.unpack a+++splitDeps :: [Str] -> ([Str], [Str], [Str])+splitDeps (x:xs) | x == BS.pack "|" = ([],a++b,c)+                 | x == BS.pack "||" = ([],b,a++c)+                 | otherwise = (x:a,b,c)+    where (a,b,c) = splitDeps xs+splitDeps [] = ([], [], [])+++getDepth :: Env Str Str -> [(Str, Expr)] -> IO Int+getDepth env xs = case lookup (BS.pack "depth") xs of+    Nothing -> pure 1+    Just x -> do+        x <- askExpr env x+        case BS.readInt x of+            Just (i, n) | BS.null n -> pure i+            _ -> error $ "Ninja parsing, could not parse depth field in pool, got: " ++ BS.unpack x
+ src/Development/Ninja/Type.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE TupleSections #-}++-- | The IO in this module is only to evaluate an environment variable,+--   the 'Env' itself it passed around purely.+module Development.Ninja.Type(+    Str, FileStr,+    Expr(..), Env, newEnv, askVar, askExpr, addEnv, addBind, addBinds,+    Ninja(..), newNinja, Build(..), Rule(..),+    ) where++import Development.Ninja.Env+import qualified Data.ByteString.Char8 as BS+import Data.Maybe+++type Str = BS.ByteString+type FileStr = Str+++---------------------------------------------------------------------+-- EXPRESSIONS AND BINDINGS++data Expr = Exprs [Expr] | Lit Str | Var Str deriving (Show,Eq)++askExpr :: Env Str Str -> Expr -> IO Str+askExpr e = f+    where f (Exprs xs) = BS.concat <$> mapM f xs+          f (Lit x) = pure x+          f (Var x) = askVar e x++askVar :: Env Str Str -> Str -> IO Str+askVar e x = fromMaybe BS.empty <$> askEnv e x++addBind :: Env Str Str -> Str -> Expr -> IO ()+addBind e k v = addEnv e k =<< askExpr e v++addBinds :: Env Str Str -> [(Str, Expr)] -> IO ()+addBinds e bs = do+    bs <- mapM (\(a,b) -> (a,) <$> askExpr e b) bs+    mapM_ (uncurry $ addEnv e) bs+++---------------------------------------------------------------------+-- STRUCTURE++data Ninja = Ninja+    {sources :: [FilePath]+    ,rules :: [(Str,Rule)]+    ,singles :: [(FileStr,Build)]+    ,multiples :: [([FileStr], Build)]+    ,phonys :: [(Str, [FileStr])]+    ,defaults :: [FileStr]+    ,pools :: [(Str, Int)]+    }+    deriving Show++newNinja :: Ninja+newNinja = Ninja [] [] [] [] [] [] []++data Build = Build+    {ruleName :: Str+    ,env :: Env Str Str+    ,depsNormal :: [FileStr]+    ,depsImplicit :: [FileStr]+    ,depsOrderOnly :: [FileStr]+    ,buildBind :: [(Str,Str)]+    } deriving Show++newtype Rule = Rule+    {ruleBind :: [(Str,Expr)]+    } deriving Show
+ src/Development/Shake.hs view
@@ -0,0 +1,255 @@+{-# LANGUAGE TypeFamilies, TypeOperators, ConstraintKinds, PatternSynonyms #-}++-- | This module is used for defining Shake build systems. As a simple example of a Shake build system,+--   let us build the file @result.tar@ from the files listed by @result.txt@:+--+-- @+-- import "Development.Shake"+-- import "Development.Shake.FilePath"+--+-- main = 'shakeArgs' 'shakeOptions' $ do+--     'want' [\"result.tar\"]+--     \"*.tar\" '%>' \\out -> do+--         contents \<- 'readFileLines' $ out 'Development.Shake.FilePath.-<.>' \"txt\"+--         'need' contents+--         'cmd' \"tar -cf\" [out] contents+-- @+--+--   We start by importing the modules defining both Shake and routines for manipulating 'FilePath' values.+--   We define @main@ to call 'shake' with the default 'shakeOptions'. As the second argument to+--   'shake', we provide a set of rules. There are two common forms of rules, 'want' to specify target files,+--   and '%>' to define a rule which builds a 'FilePattern'. We use 'want' to require that after the build+--   completes the file @result.tar@ should be ready.+--+--   The @*.tar@ rule describes how to build files with the extension @.tar@, including @result.tar@.+--   We 'readFileLines' on @result.txt@, after changing the @.tar@ extension to @.txt@. We read each line+--   into the variable @contents@ -- being a list of the files that should go into @result.tar@. Next, we+--   depend ('need') all the files in @contents@. If any of these files change, the rule will be repeated.+--   Finally we call the @tar@ program. If either @result.txt@ changes, or any of the files listed by @result.txt@+--   change, then @result.tar@ will be rebuilt.+--+--   To find out more:+--+-- * The user manual contains a longer example and background information on how to use Shake+--   <https://www.shakebuild.com/manual>.+--+-- * The home page has links to additional information <https://www.shakebuild.com/>, including+--   a mailing list.+--+-- * The theory behind Shake is described in an ICFP 2012 paper,+--   <https://ndmitchell.com/downloads/paper-shake_before_building-10_sep_2012.pdf Shake Before Building -- Replacing Make with Haskell>.+--   The <https://www.youtube.com/watch?v=xYCPpXVlqFM associated talk> forms a short overview of Shake.+module Development.Shake(+    -- * Writing a build system+    -- $writing++    -- * GHC build flags+    -- $flags++    -- * Other Shake modules+    -- $modules++    -- * Core+    shake,+    shakeOptions,+    Rules, action, withoutActions, alternatives, priority, versioned,+    Action, traced,+    liftIO, actionOnException, actionFinally, actionBracket, actionCatch, actionRetry, runAfter,+    ShakeException(..),+    -- * Configuration+    ShakeOptions(..), Rebuild(..), Lint(..), Change(..),+    getShakeOptions, getShakeOptionsRules, getHashedShakeVersion,+    getShakeExtra, getShakeExtraRules, addShakeExtra,+    -- ** Command line+    shakeArgs, shakeArgsWith, shakeArgsOptionsWith, shakeOptDescrs, addHelpSuffix,+    -- ** Targets+    getTargets, addTarget, withTargetDocs, withoutTargets,+    -- ** Progress reporting+    Progress(..), progressSimple, progressDisplay, progressTitlebar, progressProgram, getProgress,+    -- ** Verbosity+    Verbosity(..), getVerbosity, putVerbose, putInfo, putWarn, putError, withVerbosity, quietly,+    -- * Running commands+    command, command_, cmd, cmd_, unit,+    Stdout(..), StdoutTrim(..), Stderr(..), Stdouterr(..), Exit(..), Process(..), CmdTime(..), CmdLine(..), FSATrace(..),+    CmdResult, CmdString, CmdOption(..),+    addPath, addEnv,+    -- * Explicit parallelism+    parallel, forP, par,+    -- * Utility functions+    copyFile', copyFileChanged,+    readFile', readFileLines,+    writeFile', writeFileLines, writeFileChanged,+    removeFiles, removeFilesAfter,+    withTempFile, withTempDir,+    withTempFileWithin, withTempDirWithin,+    -- * File rules+    need, want, (%>), (|%>), (?>), phony, (~>), phonys,+    (&%>), (&?>),+    orderOnly, orderOnlyAction,+    FilePattern, (?==), (<//>), filePattern,+    needed, trackRead, trackWrite, trackAllow,+    -- * Directory rules+    doesFileExist, doesDirectoryExist, getDirectoryContents, getDirectoryFiles, getDirectoryDirs,+    getDirectoryFilesIO,+    -- * Environment rules+    getEnv, getEnvWithDefault, getEnvError,+    -- * Oracle rules+    ShakeValue, RuleResult, addOracle, addOracleCache, addOracleHash, askOracle, askOracles,+    -- * Special rules+    alwaysRerun,+    -- * Resources+    Resource, newResource, newResourceIO, withResource, withResources,+    newThrottle, newThrottleIO,+    unsafeExtraThread,+    -- * Cache+    newCache, newCacheIO,+    historyDisable, produces,+    -- * Batching+    needHasChanged,+    resultHasChanged,+    batch,+    reschedule,+    -- * Deprecated+    askOracleWith,+    deprioritize,+    pattern Quiet, pattern Normal, pattern Loud, pattern Chatty,+    putLoud, putNormal, putQuiet+    ) where++-- I would love to use module export in the above export list, but alas Haddock+-- then shows all the things that are hidden in the docs, which is terrible.+import Control.Monad.IO.Class+import Development.Shake.Internal.Value+import Development.Shake.Internal.Options+import Development.Shake.Internal.Core.Types+import Development.Shake.Internal.Core.Action+import Development.Shake.Internal.Core.Rules+import Development.Shake.Internal.Resource+import Development.Shake.Internal.Derived+import Development.Shake.Internal.Errors+import Development.Shake.Internal.Progress+import Development.Shake.Internal.Args++import Development.Shake.Command+import Development.Shake.Internal.FilePattern+import Development.Shake.Internal.Rules.Directory+import Development.Shake.Internal.Rules.File+import Development.Shake.Internal.Rules.Files+import Development.Shake.Internal.Rules.Oracle+import Development.Shake.Internal.Rules.OrderOnly+import Development.Shake.Internal.Rules.Rerun++-- $writing+--+--   When writing a Shake build system, start by defining what you 'want', then write rules+--   with '%>' to produce the results. Before calling 'cmd' you should ensure that any files the command+--   requires are demanded with calls to 'need'. We offer the following advice to Shake users:+--+-- * If @ghc --make@ or @cabal@ is capable of building your project, use that instead. Custom build systems are+--   necessary for many complex projects, but many projects are not complex.+--+-- * The 'shakeArgs' function automatically handles command line arguments. To define non-file targets use 'phony'.+--+-- * Put all result files in a distinguished directory, for example @_make@. You can implement a @clean@+--   command by removing that directory, using @'removeFilesAfter' \"_make\" [\"\/\/\*\"]@.+--+-- * To obtain parallel builds set 'shakeThreads' to a number greater than 1.+--+-- * Lots of compilers produce @.o@ files. To avoid overlapping rules, use @.c.o@ for C compilers,+--   @.hs.o@ for Haskell compilers etc.+--+-- * Do not be afraid to mix Shake rules, system commands and other Haskell libraries -- use each for what+--   it does best.+--+-- * The more accurate the dependencies are, the better. Use additional rules like 'doesFileExist' and+--   'getDirectoryFiles' to track information other than just the contents of files. For information in the environment+--   that you suspect will change regularly (perhaps @ghc@ version number), either write the information to+--   a file with 'alwaysRerun' and 'writeFileChanged', or use 'addOracle'.++-- $flags+--+--   For large build systems the choice of GHC flags can have a significant impact. We recommend:+--+-- > ghc --make MyBuildSystem -threaded -rtsopts "-with-rtsopts=-I0 -qg"+--+--   * @-rtsopts@: Allow the setting of further GHC options at runtime.+--+--   * @-I0@: Disable idle garbage collection, to avoid frequent unnecessary garbage collection, see+--     <https://stackoverflow.com/questions/34588057/why-does-shake-recommend-disabling-idle-garbage-collection/ a full explanation>.+--+--   * You may add @-threaded@, and pass the options @-qg@ to @-with-rtsopts@+--     to disable parallel garbage collection. Parallel garbage collection in Shake+--     programs typically goes slower than sequential garbage collection, while occupying many cores that+--     could be used for running system commands.++-- $modules+--+--   The main Shake module is this one, "Development.Shake", which should be sufficient for most+--   people writing build systems using Shake. However, Shake provides some additional modules,+--+-- * "Development.Shake.Classes" provides convenience exports of the classes Shake relies on,+--   in particular 'Binary', 'Hashable' and 'NFData'. Useful for deriving these types using+--   @GeneralizedNewtypeDeriving@ without adding dependencies on the associated packages.+--+-- * "Development.Shake.Command" provides the command line wrappers. These are reexported by+--   "Development.Shake", but if you want to reuse just the command-line running functionality+--   in a non-Shake program you can import just that.+--+-- * "Development.Shake.Config" provides a way to write configuration files that are tracked.+--   The configuration files are in the Ninja format. Useful for users of bigger systems who+--   want to track the build rules not in Haskell.+--+-- * "Development.Shake.Database" provides lower level primitives to drive Shake, particularly+--   useful if you want to run multiple Shake runs in a row without reloading from the database.+--+-- * "Development.Shake.FilePath" is an extension of "System.FilePath" with a few additional+--   methods and safer extension manipulation code.+--+-- * "Development.Shake.Forward" is an alternative take on build systems, where you write the+--   rules as a script where steps are skipped, rather than as a set of dependencies. Only really+--   works if you use @fsatrace@.+--+-- * "Development.Shake.Rule" provides tools for writing your own types of Shake rules. Useful+--   if you need something new, like a rule that queries a database or similar.+--+-- * "Development.Shake.Util" has general utilities that are useful for build systems, e.g.+--   reading @Makefile@ syntax and alternative forms of argument parsing.+++---------------------------------------------------------------------+-- DEPRECATED SINCE 0.16.1, NOV 2017++-- | /Deprecated:/ Replace @'askOracleWith' q a@ by @'askOracle' q@+--   since the 'RuleResult' type family now fixes the result type.+{-# DEPRECATED askOracleWith "Use 'askOracle q' instead of 'askOracleWith q a', the result value is now unnecessary" #-}+askOracleWith :: (RuleResult q ~ a, ShakeValue q, ShakeValue a) => q -> a -> Action a+askOracleWith question _ = askOracle question++---------------------------------------------------------------------+-- DEPRECATED SINCE 0.18.4, JUL 2019++-- | /Deprecated:/ Alias for 'reschedule'.+{-# DEPRECATED deprioritize "Use 'reschedule' instead" #-}+deprioritize :: Double -> Action ()+deprioritize = reschedule++-- | /Deprecated:/ A bidirectional pattern synonym for 'Error'.+pattern Quiet :: Verbosity+pattern Quiet  = Error+-- | /Deprecated:/ A bidirectional pattern synonym for 'Info'.+pattern Normal :: Verbosity+pattern Normal = Info+-- | /Deprecated:/ A bidirectional pattern synonym for 'Verbose'.+pattern Loud :: Verbosity+pattern Loud   = Verbose+-- | /Deprecated:/ A bidirectional pattern synonym for 'Verbose'.+pattern Chatty :: Verbosity+pattern Chatty = Verbose++putLoud, putNormal, putQuiet :: String -> Action ()+-- | /Deprecated:/ Alias for 'putVerbose'.+putLoud = putVerbose+-- | /Deprecated:/ Alias for 'putInfo'.+putNormal = putInfo+-- | /Deprecated:/ Alias for 'putError'.+putQuiet = putError
+ src/Development/Shake/Classes.hs view
@@ -0,0 +1,14 @@++-- | This module reexports the six necessary type classes that many rule types must support through 'ShakeValue'.+--   You can use this module to define new rules without depending on the @binary@, @deepseq@ and @hashable@ packages.+module Development.Shake.Classes(+    Show(..), Typeable, Eq(..), Hashable(..), Binary(..), NFData(..)+    ) where++-- I would probably reexport this module by default in Development.Shake,+-- but Binary defines 'get', which clashes with the State monad.++import Data.Hashable+import Data.Typeable+import Data.Binary+import Control.DeepSeq
+ src/Development/Shake/Command.hs view
@@ -0,0 +1,763 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleInstances, TypeOperators, ScopedTypeVariables, NamedFieldPuns #-}+{-# LANGUAGE GADTs, GeneralizedNewtypeDeriving, DeriveDataTypeable, RecordWildCards #-}+++-- | This module provides functions for calling command line programs, primarily+--   'command' and 'cmd'. As a simple example:+--+-- @+-- 'command' [] \"gcc\" [\"-c\",myfile]+-- @+--+--   The functions from this module are now available directly from "Development.Shake".+--   You should only need to import this module if you are using the 'cmd' function in the 'IO' monad.+module Development.Shake.Command(+    command, command_, cmd, cmd_, unit, CmdArgument(..), CmdArguments(..), IsCmdArgument(..), (:->),+    Stdout(..), StdoutTrim(..), Stderr(..), Stdouterr(..), Exit(..), Process(..), CmdTime(..), CmdLine(..), FSATrace(..),+    CmdResult, CmdString, CmdOption(..),+    addPath, addEnv,+    ) where++import Data.Tuple.Extra+import Control.Monad.Extra+import Control.Monad.IO.Class+import Control.Exception.Extra+import Data.Char+import Data.Either.Extra+import Data.Foldable (toList)+import Data.List.Extra+import Data.List.NonEmpty (NonEmpty)+import qualified Data.HashSet as Set+import Data.Maybe+import Data.Data+import Data.Semigroup+import System.Directory+import qualified System.IO.Extra as IO+import System.Environment+import System.Exit+import System.IO.Extra hiding (withTempFile, withTempDir)+import System.Process+import System.Info.Extra+import System.Time.Extra+import System.IO.Unsafe (unsafeInterleaveIO)+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy.Char8 as LBS+import qualified Data.ByteString.UTF8 as UTF8+import General.Extra+import General.Process+import Prelude++import Development.Shake.Internal.CmdOption+import Development.Shake.Internal.Core.Action+import Development.Shake.Internal.Core.Types hiding (Result)+import Development.Shake.FilePath+import Development.Shake.Internal.Options+import Development.Shake.Internal.Rules.File+import Development.Shake.Internal.Derived++---------------------------------------------------------------------+-- ACTUAL EXECUTION++-- | /Deprecated:/ Use 'AddPath'. This function will be removed in a future version.+--+--   Add a prefix and suffix to the @$PATH@ environment variable. For example:+--+-- @+-- opt <- 'addPath' [\"\/usr\/special\"] []+-- 'cmd' opt \"userbinary --version\"+-- @+--+--   Would prepend @\/usr\/special@ to the current @$PATH@, and the command would pick+--   @\/usr\/special\/userbinary@, if it exists. To add other variables see 'addEnv'.+addPath :: MonadIO m => [String] -> [String] -> m CmdOption+addPath pre post = do+    args <- liftIO getEnvironment+    let (path,other) = partition ((== "PATH") . (if isWindows then upper else id) . fst) args+    pure $ Env $+        [("PATH",intercalate [searchPathSeparator] $ pre ++ post) | null path] +++        [(a,intercalate [searchPathSeparator] $ pre ++ [b | b /= ""] ++ post) | (a,b) <- path] +++        other++-- | /Deprecated:/ Use 'AddEnv'. This function will be removed in a future version.+--+--   Add a single variable to the environment. For example:+--+-- @+-- opt <- 'addEnv' [(\"CFLAGS\",\"-O2\")]+-- 'cmd' opt \"gcc -c main.c\"+-- @+--+--   Would add the environment variable @$CFLAGS@ with value @-O2@. If the variable @$CFLAGS@+--   was already defined it would be overwritten. If you wish to modify @$PATH@ see 'addPath'.+addEnv :: MonadIO m => [(String, String)] -> m CmdOption+addEnv extra = do+    args <- liftIO getEnvironment+    pure $ Env $ extra ++ filter (\(a,_) -> a `notElem` map fst extra) args+++data Str = Str String | BS BS.ByteString | LBS LBS.ByteString | Unit deriving (Eq,Show)++strTrim :: Str -> Str+strTrim (Str x) = Str $ trim x+strTrim (BS x) = BS $ fst $ BS.spanEnd isSpace $ BS.dropWhile isSpace x+strTrim (LBS x) = LBS $ trimEnd $ LBS.dropWhile isSpace x+    where+        trimEnd x = case LBS.uncons x of+            Just (c, x2) | isSpace c -> trimEnd x2+            _ -> x+strTrim Unit = Unit+++data Result+    = ResultStdout Str+    | ResultStderr Str+    | ResultStdouterr Str+    | ResultCode ExitCode+    | ResultTime Double+    | ResultLine String+    | ResultProcess PID+    | ResultFSATrace [FSATrace FilePath]+    | ResultFSATraceBS [FSATrace BS.ByteString]+      deriving (Eq,Show)++data PID = PID0 | PID ProcessHandle+instance Eq PID where _ == _ = True+instance Show PID where show PID0 = "PID0"; show _ = "PID"++data Params = Params+    {funcName :: String+    ,opts :: [CmdOption]+    ,results :: [Result]+    ,prog :: String+    ,args :: [String]+    } deriving Show++class MonadIO m => MonadTempDir m where+    runWithTempDir :: (FilePath -> m a) -> m a+    runWithTempFile :: (FilePath -> m a) -> m a+instance MonadTempDir IO where+    runWithTempDir = IO.withTempDir+    runWithTempFile = IO.withTempFile+instance MonadTempDir Action where+    runWithTempDir = withTempDir+    runWithTempFile = withTempFile++---------------------------------------------------------------------+-- DEAL WITH Shell++removeOptionShell+    :: MonadTempDir m+    => Params -- ^ Given the parameter+    -> (Params -> m a) -- ^ Call with the revised params, program name and command line+    -> m a+removeOptionShell params@Params{..} call+    | Shell `elem` opts = do+        -- put our UserCommand first, as the last one wins, and ours is lowest priority+        let userCmdline = unwords $ prog : args+        params <- pure params{opts = UserCommand userCmdline : filter (/= Shell) opts}++        prog <- liftIO $ if isFSATrace params then copyFSABinary prog else pure prog+        let realCmdline = unwords $ prog : args+        if not isWindows then+            call params{prog = "/bin/sh", args = ["-c",realCmdline]}+        else+            -- On Windows the Haskell behaviour isn't that clean and is very fragile, so we try and do better.+            runWithTempDir $ \dir -> do+                let file = dir </> "s.bat"+                writeFile' file realCmdline+                call params{prog = "cmd.exe", args = ["/d/q/c",file]}+    | otherwise = call params+++---------------------------------------------------------------------+-- DEAL WITH FSATrace++isFSATrace :: Params -> Bool+isFSATrace Params{..} = any isResultFSATrace  results || any isFSAOptions opts++-- Mac disables tracing on system binaries, so we copy them over, yurk+copyFSABinary :: FilePath -> IO FilePath+copyFSABinary prog+    | not isMac = pure prog+    | otherwise = do+        progFull <- findExecutable prog+        case progFull of+            Just x | any (`isPrefixOf` x) ["/bin/","/usr/","/sbin/"] -> do+                -- The file is one of the ones we can't trace, so we make a copy of it in $TMP and run that+                -- We deliberately don't clean up this directory, since otherwise we spend all our time copying binaries over+                tmpdir <- getTemporaryDirectory+                let fake = tmpdir </> "fsatrace-fakes" ++ x -- x is absolute, so must use +++                unlessM (doesFileExist fake) $ do+                    createDirectoryRecursive $ takeDirectory fake+                    copyFile x fake+                pure fake+            _ -> pure prog++removeOptionFSATrace+    :: MonadTempDir m+    => Params -- ^ Given the parameter+    -> (Params -> m [Result]) -- ^ Call with the revised params, program name and command line+    -> m [Result]+removeOptionFSATrace params@Params{..} call+    | not $ isFSATrace params = call params+    | ResultProcess PID0 `elem` results =+        -- This is a bad state to get into, you could technically just ignore the tracing, but that's a bit dangerous+        liftIO $ errorIO "Asyncronous process execution combined with FSATrace is not support"+    | otherwise = runWithTempFile $ \file -> do+        liftIO $ writeFile file "" -- ensures even if we fail before fsatrace opens the file, we can still read it+        params <- liftIO $ fsaParams file params+        res <- call params{opts = UserCommand (showCommandForUser2 prog args) : filter (not . isFSAOptions) opts}+        fsaResBS <- liftIO $ parseFSA <$> BS.readFile file+        let fsaRes = map (fmap UTF8.toString) fsaResBS+        pure $ flip map res $ \case+            ResultFSATrace [] -> ResultFSATrace fsaRes+            ResultFSATraceBS [] -> ResultFSATraceBS fsaResBS+            x -> x+    where+        fsaFlags = lastDef "rwmdqt" [x | FSAOptions x <- opts]++        fsaParams file Params{..} = do+            prog <- copyFSABinary prog+            pure params{prog = "fsatrace", args = fsaFlags : file : "--" : prog : args }+++isFSAOptions FSAOptions{} = True+isFSAOptions _ = False++isResultFSATrace ResultFSATrace{} = True+isResultFSATrace ResultFSATraceBS{} = True+isResultFSATrace _ = False++addFSAOptions :: String -> [CmdOption] -> [CmdOption]+addFSAOptions x opts | any isFSAOptions opts = map f opts+    where f (FSAOptions y) = FSAOptions $ nubOrd $ y ++ x+          f x = x+addFSAOptions x opts = FSAOptions x : opts+++-- | The results produced by @fsatrace@. All files will be absolute paths.+--   You can get the results for a 'cmd' by requesting a value of type+--   @['FSATrace']@.+data FSATrace a+    = -- | Writing to a file+      FSAWrite a+    | -- | Reading from a file+      FSARead a+    | -- | Deleting a file+      FSADelete a+    | -- | Moving, arguments destination, then source+      FSAMove a a+    | -- | Querying\/stat on a file+      FSAQuery a+    | -- | Touching a file+      FSATouch a+      deriving (Show,Eq,Ord,Data,Typeable,Functor)+++-- | Parse the 'FSATrace' entries, ignoring anything you don't understand.+parseFSA :: BS.ByteString -> [FSATrace BS.ByteString]+parseFSA = mapMaybe (f . dropR) . BS.lines+    where+        -- deal with CRLF on Windows+        dropR x = case BS.unsnoc x of+            Just (x, '\r') -> x+            _ -> x++        f x+            | Just (k, x) <- BS.uncons x+            , Just ('|', x) <- BS.uncons x =+                case k of+                    'w' -> Just $ FSAWrite x+                    'r' -> Just $ FSARead  x+                    'd' -> Just $ FSADelete x+                    'm' | (xs, ys) <- BS.break (== '|') x, Just ('|',ys) <- BS.uncons ys ->+                        Just $ FSAMove xs ys+                    'q' -> Just $ FSAQuery x+                    't' -> Just $ FSATouch x+                    _ -> Nothing+            | otherwise = Nothing+++---------------------------------------------------------------------+-- ACTION EXPLICIT OPERATION++-- | Given explicit operations, apply the Action ones, like skip/trace/track/autodep+commandExplicitAction :: Partial => Params -> Action [Result]+commandExplicitAction oparams = do+    ShakeOptions{shakeCommandOptions,shakeRunCommands,shakeLint,shakeLintInside} <- getShakeOptions+    params@Params{..}<- pure $ oparams{opts = shakeCommandOptions ++ opts oparams}++    let skipper act = if null results && not shakeRunCommands then pure [] else act++    let verboser act = do+            let cwd = listToMaybe $ reverse [x | Cwd x <- opts]+            putVerbose $+                maybe "" (\x -> "cd " ++ x ++ "; ") cwd +++                lastDef (showCommandForUser2 prog args) [x | UserCommand x <- opts]+            verb <- getVerbosity+            -- run quietly to suppress the tracer (don't want to print twice)+            (if verb >= Verbose then quietly else id) act++    let tracer act = do+            -- note: use the oparams - find a good tracing before munging it for shell stuff+            let msg = lastDef (defaultTraced oparams) [x | Traced x <- opts]+            if msg == "" then liftIO act else traced msg act++    let async = ResultProcess PID0 `elem` results+    let tracker act+            | AutoDeps `elem` opts = if async then liftIO $ errorIO "Can't use AutoDeps and asyncronous execution" else autodeps act+            | shakeLint == Just LintFSATrace && not async = fsalint act+            | otherwise = act params++        autodeps act = do+            ResultFSATrace pxs : res <- act params{opts = addFSAOptions "rwm" opts, results = ResultFSATrace [] : results}+            let written = Set.fromList $ [x | FSAMove x _ <- pxs] ++ [x | FSAWrite x <- pxs]+            -- If something both reads and writes to a file, it isn't eligible to be an autodeps+            xs <- liftIO $ filterM doesFileExist [x | FSARead x <- pxs, not $ x `Set.member` written]+            cwd <- liftIO getCurrentDirectory+            temp <- fixPaths cwd xs+            unsafeAllowApply $ need temp+            pure res++        fixPaths cwd xs = liftIO $ do+            xs<- pure $ map toStandard xs+            xs<- pure $ filter (\x -> any (`isPrefixOf` x) shakeLintInside) xs+            mapM (\x -> fromMaybe x <$> makeRelativeEx cwd x) xs++        fsalint act = do+            ResultFSATrace xs : res <- act params{opts = addFSAOptions "rwm" opts, results = ResultFSATrace [] : results}+            let reader (FSARead x) = Just x; reader _ = Nothing+                writer (FSAWrite x) = Just x; writer (FSAMove x _) = Just x; writer _ = Nothing+                existing f = liftIO . filterM doesFileExist . nubOrd . mapMaybe f+            cwd <- liftIO getCurrentDirectory+            trackRead  =<< fixPaths cwd =<< existing reader xs+            trackWrite =<< fixPaths cwd =<< existing writer xs+            pure res++    skipper $ tracker $ \params -> verboser $ tracer $ commandExplicitIO params+++defaultTraced :: Params -> String+defaultTraced Params{..} = takeBaseName $ if Shell `elem` opts then fst (word1 prog) else prog+++---------------------------------------------------------------------+-- IO EXPLICIT OPERATION++-- | Given a very explicit set of CmdOption, translate them to a General.Process structure+commandExplicitIO :: Partial => Params -> IO [Result]+commandExplicitIO params = removeOptionShell params $ \params -> removeOptionFSATrace params $ \Params{..} -> do+    let (grabStdout, grabStderr) = both or $ unzip $ flip map results $ \case+            ResultStdout{} -> (True, False)+            ResultStderr{} -> (False, True)+            ResultStdouterr{} -> (True, True)+            _ -> (False, False)++    optEnv <- resolveEnv opts+    let optCwd = mergeCwd [x | Cwd x <- opts]+    let optStdin = flip mapMaybe opts $ \case+            Stdin x -> Just $ SrcString x+            StdinBS x -> Just $ SrcBytes x+            FileStdin x -> Just $ SrcFile x+            InheritStdin -> Just SrcInherit+            _ -> Nothing+    let optBinary = BinaryPipes `elem` opts+    let optAsync = ResultProcess PID0 `elem` results+    let optTimeout = listToMaybe $ reverse [x | Timeout x <- opts]+    let optWithStdout = lastDef False [x | WithStdout x <- opts]+    let optWithStderr = lastDef True [x | WithStderr x <- opts]+    let optFileStdout = [x | FileStdout x <- opts]+    let optFileStderr = [x | FileStderr x <- opts]+    let optEchoStdout = lastDef (not grabStdout && null optFileStdout) [x | EchoStdout x <- opts]+    let optEchoStderr = lastDef (not grabStderr && null optFileStderr) [x | EchoStderr x <- opts]+    let optRealCommand = showCommandForUser2 prog args+    let optUserCommand = lastDef optRealCommand [x | UserCommand x <- opts]+    let optCloseFds = CloseFileHandles `elem` opts+    let optProcessGroup = NoProcessGroup `notElem` opts++    let bufLBS f = do (a,b) <- buf $ LBS LBS.empty; pure (a, (\(LBS x) -> f x) <$> b)+        buf Str{} | optBinary = bufLBS (Str . LBS.unpack)+        buf Str{} = do x <- newBuffer; pure ([DestString x | not optAsync], Str . concat <$> readBuffer x)+        buf LBS{} = do x <- newBuffer; pure ([DestBytes x | not optAsync], LBS . LBS.fromChunks <$> readBuffer x)+        buf BS {} = bufLBS (BS . BS.concat . LBS.toChunks)+        buf Unit  = pure ([], pure Unit)+    (dStdout, dStderr, resultBuild) :: ([[Destination]], [[Destination]], [Double -> ProcessHandle -> ExitCode -> IO Result]) <-+        fmap unzip3 $ forM results $ \case+            ResultCode _ -> pure ([], [], \_ _ ex -> pure $ ResultCode ex)+            ResultTime _ -> pure ([], [], \dur _ _ -> pure $ ResultTime dur)+            ResultLine _ -> pure ([], [], \_ _ _ -> pure $ ResultLine optUserCommand)+            ResultProcess _ -> pure ([], [], \_ pid _ -> pure $ ResultProcess $ PID pid)+            ResultStdout    s -> do (a,b) <- buf s; pure (a , [], \_ _ _ -> fmap ResultStdout b)+            ResultStderr    s -> do (a,b) <- buf s; pure ([], a , \_ _ _ -> fmap ResultStderr b)+            ResultStdouterr s -> do (a,b) <- buf s; pure (a , a , \_ _ _ -> fmap ResultStdouterr b)+            ResultFSATrace _ -> pure ([], [], \_ _ _ -> pure $ ResultFSATrace []) -- filled in elsewhere+            ResultFSATraceBS _ -> pure ([], [], \_ _ _ -> pure $ ResultFSATraceBS []) -- filled in elsewhere++    exceptionBuffer <- newBuffer+    po <- resolvePath ProcessOpts+        {poCommand = RawCommand prog args+        ,poCwd = optCwd, poEnv = optEnv, poTimeout = optTimeout+        ,poStdin = [SrcBytes LBS.empty | optBinary && not (null optStdin)] ++ optStdin+        ,poStdout = [DestEcho | optEchoStdout] ++ map DestFile optFileStdout ++ [DestString exceptionBuffer | optWithStdout && not optAsync] ++ concat dStdout+        ,poStderr = [DestEcho | optEchoStderr] ++ map DestFile optFileStderr ++ [DestString exceptionBuffer | optWithStderr && not optAsync] ++ concat dStderr+        ,poAsync = optAsync+        ,poCloseFds = optCloseFds+        ,poGroup = optProcessGroup+        }+    (dur,(pid,exit)) <- duration $ process po+    if exit == ExitSuccess || ResultCode ExitSuccess `elem` results then+        mapM (\f -> f dur pid exit) resultBuild+     else do+        exceptionBuffer <- readBuffer exceptionBuffer+        let captured = ["Stderr" | optWithStderr] ++ ["Stdout" | optWithStdout]+        cwd <- case optCwd of+            Nothing -> pure ""+            Just v -> do+                v <- canonicalizePath v `catchIO` const (pure v)+                pure $ "Current directory: " ++ v ++ "\n"+        liftIO $ errorIO $+            "Development.Shake." ++ funcName ++ ", system command failed\n" +++            "Command line: " ++ optRealCommand ++ "\n" +++            (if optRealCommand /= optUserCommand then "Original command line: " ++ optUserCommand ++ "\n" else "") +++            cwd +++            "Exit code: " ++ show (case exit of ExitFailure i -> i; _ -> 0) ++ "\n" +++            if null captured then "Stderr not captured because WithStderr False was used\n"+            else if null exceptionBuffer then intercalate " and " captured ++ " " ++ (if length captured == 1 then "was" else "were") ++ " empty"+            else intercalate " and " captured ++ ":\n" ++ unlines (dropWhile null $ lines $ concat exceptionBuffer)+++mergeCwd :: [FilePath] -> Maybe FilePath+mergeCwd [] = Nothing+mergeCwd xs = Just $ foldl1 (</>) xs++-- | Apply all environment operations, to produce a new environment to use.+resolveEnv :: [CmdOption] -> IO (Maybe [(String, String)])+resolveEnv opts+    | null env, null addEnv, null addPath, null remEnv = pure Nothing+    | otherwise = Just . unique . tweakPath . (++ addEnv) . filter (flip notElem remEnv . fst) <$>+                  if null env then getEnvironment else pure (concat env)+    where+        env = [x | Env x <- opts]+        addEnv = [(x,y) | AddEnv x y <- opts]+        remEnv = [x | RemEnv x <- opts]+        addPath = [(x,y) | AddPath x y <- opts]++        newPath mid = intercalate [searchPathSeparator] $+            concat (reverse $ map fst addPath) ++ [mid | mid /= ""] ++ concatMap snd addPath+        isPath x = (if isWindows then upper else id) x == "PATH"+        tweakPath xs | not $ any (isPath . fst) xs = ("PATH", newPath "") : xs+                     | otherwise = map (\(a,b) -> (a, if isPath a then newPath b else b)) xs++        unique = reverse . nubOrdOn (if isWindows then upper . fst else fst) . reverse+++-- | If the user specifies a custom $PATH, and not Shell, then try and resolve their prog ourselves.+--   Tricky, because on Windows it doesn't look in the $PATH first.+resolvePath :: ProcessOpts -> IO ProcessOpts+resolvePath po+    | Just e <- poEnv po+    , Just (_, path) <- find ((==) "PATH" . (if isWindows then upper else id) . fst) e+    , RawCommand prog args <- poCommand po+    = do+    let progExe = if prog == prog -<.> exe then prog else prog <.> exe+    -- use unsafeInterleaveIO to allow laziness to skip the queries we don't use+    pathOld <- unsafeInterleaveIO $ fromMaybe "" <$> lookupEnv "PATH"+    old <- unsafeInterleaveIO $ findExecutable prog+    new <- unsafeInterleaveIO $ findExecutableWith (splitSearchPath path) progExe+    old2 <- unsafeInterleaveIO $ findExecutableWith (splitSearchPath pathOld) progExe++    switch<- pure $ case () of+        _ | path == pathOld -> False -- The state I can see hasn't changed+          | Nothing <- new -> False -- I have nothing to offer+          | Nothing <- old -> True -- I failed last time, so this must be an improvement+          | Just old <- old, Just new <- new, equalFilePath old new -> False -- no different+          | Just old <- old, Just old2 <- old2, equalFilePath old old2 -> True -- I could predict last time+          | otherwise -> False+    pure $ case new of+        Just new | switch -> po{poCommand = RawCommand new args}+        _ -> po+resolvePath po = pure po+++-- | Given a list of directories, and a file name, return the complete path if you can find it.+--   Like findExecutable, but with a custom PATH.+findExecutableWith :: [FilePath] -> String -> IO (Maybe FilePath)+findExecutableWith path x = flip firstJustM (map (</> x) path) $ \s ->+    ifM (doesFileExist s) (pure $ Just s) (pure Nothing)+++---------------------------------------------------------------------+-- FIXED ARGUMENT WRAPPER++-- | Collect the @stdout@ of the process.+--   If used, the @stdout@ will not be echoed to the terminal, unless you include 'EchoStdout'.+--   The value type may be either 'String', or either lazy or strict 'ByteString'.+--+--   Note that most programs end their output with a trailing newline, so calling+--   @ghc --numeric-version@ will result in 'Stdout' of @\"6.8.3\\n\"@. If you want to automatically+--   trim the resulting string, see 'StdoutTrim'.+newtype Stdout a = Stdout {fromStdout :: a}++-- | Like 'Stdout' but remove all leading and trailing whitespaces.+newtype StdoutTrim a = StdoutTrim {fromStdoutTrim :: a}++-- | Collect the @stderr@ of the process.+--   If used, the @stderr@ will not be echoed to the terminal, unless you include 'EchoStderr'.+--   The value type may be either 'String', or either lazy or strict 'ByteString'.+newtype Stderr a = Stderr {fromStderr :: a}++-- | Collect the @stdout@ and @stderr@ of the process.+--   If used, the @stderr@ and @stdout@ will not be echoed to the terminal, unless you include 'EchoStdout' and 'EchoStderr'.+--   The value type may be either 'String', or either lazy or strict 'ByteString'.+newtype Stdouterr a = Stdouterr {fromStdouterr :: a}++-- | Collect the 'ExitCode' of the process.+--   If you do not collect the exit code, any 'ExitFailure' will cause an exception.+newtype Exit = Exit {fromExit :: ExitCode}++-- | Collect the 'ProcessHandle' of the process.+--   If you do collect the process handle, the command will run asyncronously and the call to 'cmd' \/ 'command'+--   will return as soon as the process is spawned. Any 'Stdout' \/ 'Stderr' captures will return empty strings.+newtype Process = Process {fromProcess :: ProcessHandle}++-- | Collect the time taken to execute the process. Can be used in conjunction with 'CmdLine' to+--   write helper functions that print out the time of a result.+--+-- @+-- timer :: ('CmdResult' r, MonadIO m) => (forall r . 'CmdResult' r => m r) -> m r+-- timer act = do+--     ('CmdTime' t, 'CmdLine' x, r) <- act+--     liftIO $ putStrLn $ \"Command \" ++ x ++ \" took \" ++ show t ++ \" seconds\"+--     pure r+--+-- run :: IO ()+-- run = timer $ 'cmd' \"ghc --version\"+-- @+newtype CmdTime = CmdTime {fromCmdTime :: Double}++-- | Collect the command line used for the process. This command line will be approximate -+--   suitable for user diagnostics, but not for direct execution.+newtype CmdLine = CmdLine {fromCmdLine :: String}++-- | The allowable 'String'-like values that can be captured.+class CmdString a where cmdString :: (Str, Str -> a)+instance CmdString () where cmdString = (Unit, \Unit -> ())+instance CmdString String where cmdString = (Str "", \(Str x) -> x)+instance CmdString BS.ByteString where cmdString = (BS BS.empty, \(BS x) -> x)+instance CmdString LBS.ByteString where cmdString = (LBS LBS.empty, \(LBS x) -> x)+++class Unit a+instance {-# OVERLAPPING #-} Unit b => Unit (a -> b)+instance {-# OVERLAPPABLE #-} a ~ () => Unit (m a)+++-- | A class for specifying what results you want to collect from a process.+--   Values are formed of 'Stdout', 'Stderr', 'Exit' and tuples of those.+class CmdResult a where+    -- Return a list of results (with the right type but dummy data)+    -- and a function to transform a populated set of results into a value+    cmdResult :: ([Result], [Result] -> a)++instance CmdResult Exit where+    cmdResult = ([ResultCode ExitSuccess], \[ResultCode x] -> Exit x)++instance CmdResult ExitCode where+    cmdResult = ([ResultCode ExitSuccess], \[ResultCode x] -> x)++instance CmdResult Process where+    cmdResult = ([ResultProcess PID0], \[ResultProcess (PID x)] -> Process x)++instance CmdResult ProcessHandle where+    cmdResult = ([ResultProcess PID0], \[ResultProcess (PID x)] -> x)++instance CmdResult CmdLine where+    cmdResult = ([ResultLine ""], \[ResultLine x] -> CmdLine x)++instance CmdResult CmdTime where+    cmdResult = ([ResultTime 0], \[ResultTime x] -> CmdTime x)++instance CmdResult [FSATrace FilePath] where+    cmdResult = ([ResultFSATrace []], \[ResultFSATrace x] -> x)++instance CmdResult [FSATrace BS.ByteString] where+    cmdResult = ([ResultFSATraceBS []], \[ResultFSATraceBS x] -> x)++instance CmdString a => CmdResult (Stdout a) where+    cmdResult = let (a,b) = cmdString in ([ResultStdout a], \[ResultStdout x] -> Stdout $ b x)++instance CmdString a => CmdResult (StdoutTrim a) where+    cmdResult = let (a,b) = cmdString in ([ResultStdout a], \[ResultStdout x] -> StdoutTrim $ b $ strTrim x)++instance CmdString a => CmdResult (Stderr a) where+    cmdResult = let (a,b) = cmdString in ([ResultStderr a], \[ResultStderr x] -> Stderr $ b x)++instance CmdString a => CmdResult (Stdouterr a) where+    cmdResult = let (a,b) = cmdString in ([ResultStdouterr a], \[ResultStdouterr x] -> Stdouterr $ b x)++instance CmdResult () where+    cmdResult = ([], \[] -> ())++instance (CmdResult x1, CmdResult x2) => CmdResult (x1,x2) where+    cmdResult = (a1++a2, \rs -> let (r1,r2) = splitAt (length a1) rs in (b1 r1, b2 r2))+        where (a1,b1) = cmdResult+              (a2,b2) = cmdResult++cmdResultWith :: forall b c. CmdResult b => (b -> c) -> ([Result], [Result] -> c)+cmdResultWith f = second (f .) cmdResult++instance (CmdResult x1, CmdResult x2, CmdResult x3) => CmdResult (x1,x2,x3) where+    cmdResult = cmdResultWith $ \(a,(b,c)) -> (a,b,c)++instance (CmdResult x1, CmdResult x2, CmdResult x3, CmdResult x4) => CmdResult (x1,x2,x3,x4) where+    cmdResult = cmdResultWith $ \(a,(b,c,d)) -> (a,b,c,d)++instance (CmdResult x1, CmdResult x2, CmdResult x3, CmdResult x4, CmdResult x5) => CmdResult (x1,x2,x3,x4,x5) where+    cmdResult = cmdResultWith $ \(a,(b,c,d,e)) -> (a,b,c,d,e)+++-- | Execute a system command. Before running 'command' make sure you 'Development.Shake.need' any files+--   that are used by the command.+--+--   This function takes a list of options (often just @[]@, see 'CmdOption' for the available+--   options), the name of the executable (either a full name, or a program on the @$PATH@) and+--   a list of arguments. The result is often @()@, but can be a tuple containg any of 'Stdout',+--   'Stderr' and 'Exit'. Some examples:+--+-- @+-- 'command_' [] \"gcc\" [\"-c\",\"myfile.c\"]                          -- compile a file, throwing an exception on failure+-- 'Exit' c <- 'command' [] \"gcc\" [\"-c\",myfile]                     -- run a command, recording the exit code+-- ('Exit' c, 'Stderr' err) <- 'command' [] \"gcc\" [\"-c\",\"myfile.c\"]   -- run a command, recording the exit code and error output+-- 'Stdout' out <- 'command' [] \"gcc\" [\"-MM\",\"myfile.c\"]            -- run a command, recording the output+-- 'command_' ['Cwd' \"generated\"] \"gcc\" [\"-c\",myfile]               -- run a command in a directory+-- @+--+--   Unless you retrieve the 'ExitCode' using 'Exit', any 'ExitFailure' will throw an error, including+--   the 'Stderr' in the exception message. If you capture the 'Stdout' or 'Stderr', that stream will not be echoed to the console,+--   unless you use the option 'EchoStdout' or 'EchoStderr'.+--+--   If you use 'command' inside a @do@ block and do not use the result, you may get a compile-time error about being+--   unable to deduce 'CmdResult'. To avoid this error, use 'command_'.+--+--   By default the @stderr@ stream will be captured for use in error messages, and also echoed. To only echo+--   pass @'WithStderr' 'False'@, which causes no streams to be captured by Shake, and certain programs (e.g. @gcc@)+--   to detect they are running in a terminal.+command :: (Partial, CmdResult r) => [CmdOption] -> String -> [String] -> Action r+command opts x xs = withFrozenCallStack $ b <$> commandExplicitAction (Params "command" opts a x xs)+    where (a,b) = cmdResult++-- | A version of 'command' where you do not require any results, used to avoid errors about being unable+--   to deduce 'CmdResult'.+command_ :: Partial => [CmdOption] -> String -> [String] -> Action ()+command_ opts x xs = withFrozenCallStack $ void $ commandExplicitAction (Params "command_" opts [] x xs)+++---------------------------------------------------------------------+-- VARIABLE ARGUMENT WRAPPER++-- | A type annotation, equivalent to the first argument, but in variable argument contexts,+--   gives a clue as to what return type is expected (not actually enforced).+type a :-> t = a+++-- | Build or execute a system command. Before using 'cmd' to run a command, make sure you 'Development.Shake.need' any files+--   that are used by the command.+--+-- * @String@ arguments are treated as a list of whitespace separated arguments.+--+-- * @[String]@ arguments are treated as a list of literal arguments.+--+-- * 'CmdOption' arguments are used as options.+--+-- * 'CmdArgument' arguments, which can be built by 'cmd' itself, are spliced into the containing command.+--+--   Typically only string literals should be passed as @String@ arguments. When using variables+--   prefer @[myvar]@ so that if @myvar@ contains spaces they are properly escaped.+--+--   As some examples, here are some calls, and the resulting command string:+--+-- @+-- 'cmd_' \"git log --pretty=\" \"oneline\"           -- git log --pretty= oneline+-- 'cmd_' \"git log --pretty=\" [\"oneline\"]         -- git log --pretty= oneline+-- 'cmd_' \"git log\" (\"--pretty=\" ++ \"oneline\")    -- git log --pretty=oneline+-- 'cmd_' \"git log\" (\"--pretty=\" ++ \"one line\")   -- git log --pretty=one line+-- 'cmd_' \"git log\" [\"--pretty=\" ++ \"one line\"]   -- git log "--pretty=one line"+-- @+--+--   More examples, including return values, see this translation of the examples given for the 'command' function:+--+-- @+-- 'cmd_' \"gcc -c myfile.c\"                                       -- compile a file, throwing an exception on failure+-- 'Exit' c <- 'cmd' \"gcc -c\" [myfile]                              -- run a command, recording the exit code+-- ('Exit' c, 'Stderr' err) <- 'cmd' \"gcc -c myfile.c\"                -- run a command, recording the exit code and error output+-- 'Stdout' out <- 'cmd' \"gcc -MM myfile.c\"                         -- run a command, recording the output+-- 'cmd' ('Cwd' \"generated\") \"gcc -c\" [myfile] :: 'Action' ()         -- run a command in a directory+--+-- let gccCommand = 'cmd' \"gcc -c\" :: 'CmdArgument'                 -- build a sub-command. 'cmd' can return 'CmdArgument' values as well as execute commands+-- cmd ('Cwd' \"generated\") gccCommand [myfile]                 -- splice that command into a greater command+-- @+--+--   If you use 'cmd' inside a @do@ block and do not use the result, you may get a compile-time error about being+--   unable to deduce 'CmdResult'. To avoid this error, use 'cmd_'. If you enable @OverloadedStrings@ or @OverloadedLists@+--   you may have to give type signatures to the arguments, or use the more constrained 'command' instead.+--+--   The 'cmd' function can also be run in the 'IO' monad, but then 'Traced' is ignored and command lines are not echoed.+--   As an example:+--+-- @+-- 'cmd' ('Cwd' \"generated\") 'Shell' \"gcc -c myfile.c\" :: IO ()+-- @+cmd :: (Partial, CmdArguments args) => args :-> Action r+cmd = withFrozenCallStack $ cmdArguments mempty++-- | See 'cmd'. Same as 'cmd' except with a unit result.+-- 'cmd' is to 'cmd_' as 'command' is to 'command_'.+cmd_ :: (Partial, CmdArguments args, Unit args) => args :-> Action ()+cmd_ = withFrozenCallStack cmd++-- | The arguments to 'cmd' - see 'cmd' for examples and semantics.+newtype CmdArgument = CmdArgument [Either CmdOption String]+  deriving (Eq, Semigroup, Monoid, Show)++-- | The arguments to 'cmd' - see 'cmd' for examples and semantics.+class CmdArguments t where+    -- | Arguments to cmd+    cmdArguments :: Partial => CmdArgument -> t+instance (IsCmdArgument a, CmdArguments r) => CmdArguments (a -> r) where+    cmdArguments xs x = cmdArguments $ xs `mappend` toCmdArgument x+instance CmdResult r => CmdArguments (Action r) where+    cmdArguments (CmdArgument x) = case partitionEithers x of+        (opts, x:xs) -> let (a,b) = cmdResult in b <$> commandExplicitAction (Params "cmd" opts a x xs)+        _ -> error "Error, no executable or arguments given to Development.Shake.cmd"+instance CmdResult r => CmdArguments (IO r) where+    cmdArguments (CmdArgument x) = case partitionEithers x of+        (opts, x:xs) -> let (a,b) = cmdResult in b <$> commandExplicitIO (Params "cmd" opts a x xs)+        _ -> error "Error, no executable or arguments given to Development.Shake.cmd"+instance CmdArguments CmdArgument where+    cmdArguments = id++-- | Class to convert an a  to a CmdArgument+class IsCmdArgument a where+    -- | Conversion to a CmdArgument+    toCmdArgument :: a -> CmdArgument+instance IsCmdArgument () where toCmdArgument = mempty+instance IsCmdArgument String where toCmdArgument = CmdArgument . map Right . words+instance IsCmdArgument [String] where toCmdArgument = CmdArgument . map Right+instance IsCmdArgument (NonEmpty String) where toCmdArgument = toCmdArgument . toList+instance IsCmdArgument CmdOption where toCmdArgument = CmdArgument . pure . Left+instance IsCmdArgument [CmdOption] where toCmdArgument = CmdArgument . map Left+instance IsCmdArgument CmdArgument where toCmdArgument = id+instance IsCmdArgument a => IsCmdArgument (Maybe a) where toCmdArgument = maybe mempty toCmdArgument+++---------------------------------------------------------------------+-- UTILITIES++-- A better version of showCommandForUser, which doesn't escape so much on Windows+showCommandForUser2 :: FilePath -> [String] -> String+showCommandForUser2 cmd args = unwords $ map (\x -> if safe x then x else showCommandForUser x []) $ cmd : args+    where+        safe xs = xs /= "" && not (any bad xs)+        bad x = isSpace x || (x == '\\' && not isWindows) || x `elem` ("\"\'" :: String)
+ src/Development/Shake/Config.hs view
@@ -0,0 +1,114 @@+{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, TypeFamilies #-}++-- | A module for parsing and using config files in a Shake build system. Config files+--   consist of variable bindings, for example:+--+-- > # This is my Config file+-- > HEADERS_DIR = /path/to/dir+-- > CFLAGS = -g -I${HEADERS_DIR}+-- > CFLAGS = $CFLAGS -O2+-- > include extra/file.cfg+--+--   This defines the variable @HEADERS_DIR@ (equal to @\/path\/to\/dir@), and+--   @CFLAGS@ (equal to @-g -I\/path\/to\/dir -O2@), and also includes the configuration+--   statements in the file @extra/file.cfg@. The full lexical syntax for configuration+--   files is defined here: <https://ninja-build.org/manual.html#_lexical_syntax>.+--   The use of Ninja file syntax is due to convenience and the desire to reuse an+--    externally-defined specification (but the choice of configuration language is mostly arbitrary).+--+--   To use the configuration file either use 'readConfigFile' to parse the configuration file+--   and use the values directly, or 'usingConfigFile' and 'getConfig' to track the configuration+--   values, so they become build dependencies.+module Development.Shake.Config(+    readConfigFile, readConfigFileWithEnv,+    usingConfigFile, usingConfig,+    getConfig, getConfigKeys+    ) where++import Development.Shake+import Development.Shake.Classes+import qualified Development.Ninja.Parse as Ninja+import qualified Development.Ninja.Env as Ninja+import qualified Data.HashMap.Strict as Map+import qualified Data.ByteString.UTF8 as UTF8+import Data.Tuple.Extra+import Data.List+++-- | Read a config file, returning a list of the variables and their bindings.+--   Config files use the Ninja lexical syntax:+--   <https://ninja-build.org/manual.html#_lexical_syntax>+readConfigFile :: FilePath -> IO (Map.HashMap String String)+readConfigFile = readConfigFileWithEnv []+++-- | Read a config file with an initial environment, returning a list of the variables and their bindings.+--   Config files use the Ninja lexical syntax:+--   <https://ninja-build.org/manual.html#_lexical_syntax>+readConfigFileWithEnv :: [(String, String)] -> FilePath -> IO (Map.HashMap String String)+readConfigFileWithEnv vars file = do+    env <- Ninja.newEnv+    mapM_ (uncurry (Ninja.addEnv env) . (UTF8.fromString *** UTF8.fromString)) vars+    Ninja.parse file env+    mp <- Ninja.fromEnv env+    pure $ Map.fromList $ map (UTF8.toString *** UTF8.toString) $ Map.toList mp+++newtype Config = Config String deriving (Show,Typeable,Eq,Hashable,Binary,NFData)++newtype ConfigKeys = ConfigKeys () deriving (Show,Typeable,Eq,Hashable,Binary,NFData)++type instance RuleResult Config = Maybe String+type instance RuleResult ConfigKeys = [String]+++-- | Specify the file to use with 'getConfig'.+usingConfigFile :: FilePath -> Rules ()+usingConfigFile file = do+    mp <- newCache $ \() -> do+        need [file]+        liftIO $ readConfigFile file+    addOracle $ \(Config x) -> Map.lookup x <$> mp ()+    addOracle $ \(ConfigKeys ()) -> sort . Map.keys <$> mp ()+    pure ()+++-- | Specify the values to use with 'getConfig', generally prefer+--   'usingConfigFile' unless you also need access to the values+--   of variables outside 'Action'.+usingConfig :: Map.HashMap String String -> Rules ()+usingConfig mp = do+    addOracle $ \(Config x) -> pure $ Map.lookup x mp+    addOracle $ \(ConfigKeys ()) -> pure $ sort $ Map.keys mp+    pure ()+++-- | Obtain the value of a configuration variable, returns 'Nothing' to indicate the variable+--   has no binding. Any build system using 'getConfig' /must/ call either 'usingConfigFile'+--   or 'usingConfig'. The 'getConfig' function will introduce a dependency on the configuration+--   variable (but not the whole configuration file), and if the configuration variable changes, the rule will be rerun.+--   As an example:+--+-- @+-- 'usingConfigFile' \"myconfiguration.cfg\"+-- \"*.o\" '%>' \\out -> do+--     cflags <- 'getConfig' \"CFLAGS\"+--     'cmd' \"gcc\" [out '-<.>' \"c\"] (fromMaybe \"\" cflags)+-- @+getConfig :: String -> Action (Maybe String)+getConfig = askOracle . Config+++-- | Obtain the configuration keys.+--   Any build system using 'getConfigKeys' /must/ call either 'usingConfigFile' or 'usingConfig'.+--   The 'getConfigKeys' function will introduce a dependency on the configuration keys+--   (but not the whole configuration file), and if the configuration keys change, the rule will be rerun.+--   Usually use as part of an action.+--   As an example:+--+-- @+-- 'usingConfigFile' \"myconfiguration.cfg\"+-- 'action' $ need =<< getConfigKeys+-- @+getConfigKeys :: Action [String]+getConfigKeys = askOracle $ ConfigKeys ()
+ src/Development/Shake/Database.hs view
@@ -0,0 +1,151 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RecordWildCards #-}++-- | Lower-level primitives to drive Shake, which are wrapped into the+--   'Development.Shake.shake' function. Useful if you want to perform multiple Shake+--   runs in a row without reloading from the database.+--   Sometimes used in conjunction with @'shakeFiles'=\"\/dev\/null\"@.+--   Using these functions you can approximate the 'Development.Shake.shake' experience with:+--+-- @+-- shake opts rules = do+--     (_, after) \<- 'shakeWithDatabase' opts rules $ \\db -> do+--         'shakeOneShotDatabase' db+--         'shakeRunDatabase' db []+--     'shakeRunAfter' opts after+-- @+module Development.Shake.Database(+    ShakeDatabase,+    shakeOpenDatabase,+    shakeWithDatabase,+    shakeOneShotDatabase,+    shakeRunDatabase,+    shakeLiveFilesDatabase,+    shakeProfileDatabase,+    shakeErrorsDatabase,+    shakeRunAfter+    ) where++import Control.Concurrent.Extra+import Control.Exception+import Control.Monad+import Control.Monad.IO.Class+import Data.IORef+import General.Cleanup+import Development.Shake.Internal.Errors+import Development.Shake.Internal.Options+import Development.Shake.Internal.Core.Rules+import Development.Shake.Internal.Core.Run+import Development.Shake.Internal.Core.Types+import Development.Shake.Internal.Rules.Default+++data UseState+    = Closed+    | Using String+    | Open {openOneShot :: Bool, openRequiresReset :: Bool}++-- | The type of an open Shake database. Created with+--   'shakeOpenDatabase' or 'shakeWithDatabase'. Used with+--   'shakeRunDatabase'. You may not execute simultaneous calls using 'ShakeDatabase'+--   on separate threads (it will raise an error).+data ShakeDatabase = ShakeDatabase (Var UseState) RunState++-- | Given some options and rules, return a pair. The first component opens the database,+--   the second cleans it up. The creation /does not/ need to be run masked, because the+--   cleanup is able to run at any point. Most users should prefer 'shakeWithDatabase'+--   which handles exceptions duration creation properly.+shakeOpenDatabase :: ShakeOptions -> Rules () -> IO (IO ShakeDatabase, IO ())+shakeOpenDatabase opts rules = do+    (cleanup, clean) <- newCleanup+    use <- newVar $ Open False False+    let alloc =+            withOpen use "shakeOpenDatabase" id $ \_ ->+                ShakeDatabase use <$> open cleanup opts (rules >> defaultRules)+    let free = do+            modifyVar_ use $ \case+                    Using s -> throwM $ errorStructured "Error when calling shakeOpenDatabase close function, currently running" [("Existing call", Just s)] ""+                    _ -> pure Closed+            clean+    pure (alloc, free)++withOpen :: Var UseState -> String -> (UseState -> UseState) -> (UseState -> IO a) -> IO a+withOpen var name final act = mask $ \restore -> do+    o <- modifyVar var $ \case+        Using s -> throwM $ errorStructured ("Error when calling " ++ name ++ ", currently running") [("Existing call", Just s)] ""+        Closed -> throwM $ errorStructured ("Error when calling " ++ name ++ ", already closed") [] ""+        o@Open{} -> pure (Using name, o)+    let clean = writeVar var $ final o+    res <- restore (act o) `onException` clean+    clean+    pure res++-- | Declare that a just-openned database will be used to call 'shakeRunDatabase' at most once.+--   If so, an optimisation can be applied to retain less memory.+shakeOneShotDatabase :: ShakeDatabase -> IO ()+shakeOneShotDatabase (ShakeDatabase use _) =+    withOpen use "shakeOneShotDatabase" (\o -> o{openOneShot=True}) $ \_ -> pure ()++-- | Given some options and rules, create a 'ShakeDatabase' that can be used to run+--   executions.+shakeWithDatabase :: ShakeOptions -> Rules () -> (ShakeDatabase -> IO a) -> IO a+shakeWithDatabase opts rules act = do+    (db, clean) <- shakeOpenDatabase opts rules+    (act =<< db) `finally` clean++-- | Given a 'ShakeDatabase', what files did the execution ensure were up-to-date+--   in the previous call to 'shakeRunDatabase'. Corresponds to the list of files+--   written out to 'shakeLiveFiles'.+shakeLiveFilesDatabase :: ShakeDatabase -> IO [FilePath]+shakeLiveFilesDatabase (ShakeDatabase use s) =+    withOpen use "shakeLiveFilesDatabase" id $ \_ ->+        liveFilesState s++-- | Given a 'ShakeDatabase', generate profile information to the given file about the latest run.+--   See 'shakeReport' for the types of file that can be generated.+shakeProfileDatabase :: ShakeDatabase -> FilePath -> IO ()+shakeProfileDatabase (ShakeDatabase use s) file =+    withOpen use "shakeProfileDatabase" id $ \_ ->+        profileState s file++-- | Given a 'ShakeDatabase', what files did the execution reach an error on last time.+--   Some special considerations when using this function:+--+-- * The presence of an error does not mean the build will fail, specifically if a+--   previously required dependency was run and raised an error, then the thing that previously+--   required it will be run. If the build system has changed in an untracked manner,+--   the build may succeed this time round.+--+-- * If the previous run actually failed then 'shakeRunDatabase' will have thrown an exception.+--   You probably want to catch that exception so you can make the call to 'shakeErrorsDatabase'.+--+-- * You may see a single failure reported multiple times, with increasingly large call stacks, showing+--   the ways in which the error lead to further errors throughout.+--+-- * The 'SomeException' values are highly likely to be of type 'ShakeException'.+--+-- * If you want as many errors as possible in one run set @'shakeStaunch'=True@.+shakeErrorsDatabase :: ShakeDatabase -> IO [(String, SomeException)]+shakeErrorsDatabase (ShakeDatabase use s) =+    withOpen use "shakeErrorsDatabase" id $ \_ ->+        errorsState s++-- | Given an open 'ShakeDatabase', run both whatever actions were added to the 'Rules',+--   plus the list of 'Action' given here. Returns the results from the explicitly passed+--   actions along with a list of actions to run after the database was closed, as added with+--   'Development.Shake.runAfter' and 'Development.Shake.removeFilesAfter'.+shakeRunDatabase :: ShakeDatabase -> [Action a] -> IO ([a], [IO ()])+shakeRunDatabase (ShakeDatabase use s) as =+    withOpen use "shakeRunDatabase" (\o -> o{openRequiresReset=True}) $ \Open{..} -> do+        when openRequiresReset $ do+            when openOneShot $+                throwM $ errorStructured "Error when calling shakeRunDatabase twice, after calling shakeOneShotDatabase" [] ""+            reset s+        (refs, as) <- fmap unzip $ forM as $ \a -> do+            ref <- newIORef Nothing+            pure (ref, liftIO . writeIORef ref . Just =<< a)+        after <- run s openOneShot $ map void as+        results <- mapM readIORef refs+        case sequence results of+            Just result -> pure (result, after)+            Nothing -> throwM $ errorInternal "Expected all results were written, but some where not"
+ src/Development/Shake/FilePath.hs view
@@ -0,0 +1,158 @@++-- | A module for 'FilePath' operations exposing "System.FilePath" plus some additional operations.+--+--   /Windows note:/ The extension methods ('<.>', 'takeExtension' etc) use the Posix variants since on+--   Windows @\"\/\/\*\" '<.>' \"txt\"@ produces @\"\/\/\*\\\\.txt\"@+--   (which is bad for 'Development.Shake.FilePattern' values).+module Development.Shake.FilePath(+    module System.FilePath, module System.FilePath.Posix,+    dropDirectory1, takeDirectory1, replaceDirectory1,+    makeRelativeEx, normaliseEx,+    toNative, toStandard,+    exe+    ) where++import System.Directory (canonicalizePath)+import System.Info.Extra+import Data.List.Extra+import Data.Maybe+import qualified System.FilePath as Native++import System.FilePath hiding+    (splitExtension, takeExtension, replaceExtension, dropExtension, addExtension+    ,hasExtension, (<.>), splitExtensions, takeExtensions, dropExtensions+    )+import System.FilePath.Posix+    (splitExtension, takeExtension, replaceExtension, dropExtension, addExtension+    ,hasExtension, (<.>), splitExtensions, takeExtensions, dropExtensions+    )+++-- | Drop the first directory from a 'FilePath'. Should only be used on+--   relative paths.+--+-- > dropDirectory1 "aaa/bbb" == "bbb"+-- > dropDirectory1 "aaa/" == ""+-- > dropDirectory1 "aaa" == ""+-- > dropDirectory1 "" == ""+dropDirectory1 :: FilePath -> FilePath+dropDirectory1 = drop1 . dropWhile (not . isPathSeparator)+++-- | Take the first component of a 'FilePath'. Should only be used on+--   relative paths.+--+-- > takeDirectory1 "aaa/bbb" == "aaa"+-- > takeDirectory1 "aaa/" == "aaa"+-- > takeDirectory1 "aaa" == "aaa"+takeDirectory1 :: FilePath -> FilePath+takeDirectory1 = takeWhile (not . isPathSeparator)++++-- | Replace the first component of a 'FilePath'. Should only be used on+--   relative paths.+--+-- > replaceDirectory1 "root/file.ext" "directory" == "directory/file.ext"+-- > replaceDirectory1 "root/foo/bar/file.ext" "directory" == "directory/foo/bar/file.ext"+replaceDirectory1 :: FilePath -> String -> FilePath+replaceDirectory1 x dir = dir </> dropDirectory1 x++-- | Make a path relative. Returns Nothing only when the given paths are on+-- different drives. This will try the pure function makeRelative first. If that+-- fails, the paths are canonicalised (removing any indirection and symlinks)+-- and a relative path is derived from there.+--+-- > > -- Given that "/root/a/" is not a symlink+-- > > makeRelativeEx "/root/a/" "/root/b/file.out"+-- > Just "../b/file.out"+-- >+-- > > -- Given that "/root/c/" is a symlink to "/root/e/f/g/"+-- > > makeRelativeEx "/root/c/" "/root/b/file.out"+-- > Just "../../../b/file.out"+-- >+-- > > -- On Windows+-- > > makeRelativeEx "C:\\foo" "D:\\foo\\bar"+-- > Nothing+--+makeRelativeEx :: FilePath -> FilePath -> IO (Maybe FilePath)+makeRelativeEx pathA pathB+    | isRelative makeRelativePathAPathB =+        pure (Just makeRelativePathAPathB)+    | otherwise = do+        a' <- canonicalizePath pathA+        b' <- canonicalizePath pathB+        if takeDrive a' /= takeDrive b'+            then pure Nothing+            else Just <$> makeRelativeEx' a' b'+    where+        makeRelativePathAPathB = makeRelative pathA pathB++        makeRelativeEx' :: FilePath -> FilePath -> IO FilePath+        makeRelativeEx' a b = do+            let rel = makeRelative a b+                parent = takeDirectory a+            if isRelative rel+                then pure rel+                else if a /= parent+                    then do+                        parentToB <- makeRelativeEx' parent b+                        pure (".." </> parentToB)++                    -- Impossible: makeRelative should have succeeded in finding+                    -- a relative path once `a == "/"`.+                    else error $ "Error calculating relative path from \""+                                ++ pathA ++ "\" to \"" ++ show pathB ++ "\""++-- | Normalise a 'FilePath', applying the rules:+--+-- * All 'pathSeparators' become 'pathSeparator' (@\/@ on Linux, @\\@ on Windows)+--+-- * @foo\/bar\/..\/baz@ becomes @foo\/baz@ (not universally true in the presence of symlinks)+--+-- * @foo\/.\/bar@ becomes @foo\/bar@+--+-- * @foo\/\/bar@ becomes @foo\/bar@+--+--   This function is not based on the 'normalise' function from the @filepath@ library, as that function+--   is quite broken.+normaliseEx :: FilePath -> FilePath+normaliseEx xs | a:b:xs <- xs, isWindows && sep a && sep b = '/' : f ('/':xs) -- account for UNC paths being double //+               | otherwise = f xs+    where+        sep = Native.isPathSeparator+        f o = toNative $ deslash o $ (++"/") $ concatMap ('/':) $ reverse $ g 0 $ reverse $ split o++        deslash o x+            | x == "/" = case (pre,pos) of+                (True,True) -> "/"+                (True,False) -> "/."+                (False,True) -> "./"+                (False,False) -> "."+            | otherwise = (if pre then id else drop1) $ (if pos then id else init) x+            where pre = sep $ fromMaybe ' ' $ listToMaybe o+                  pos = sep $ last $ " " ++ o++        g i [] = replicate i ".."+        g i ("..":xs) = g (i+1) xs+        g i (".":xs) = g i xs+        g 0 (x:xs) = x : g 0 xs+        g i (_:xs) = g (i-1) xs -- equivalent to eliminating ../x++        split xs = if null ys then [] else a : split b+            where (a,b) = break sep ys+                  ys = dropWhile sep xs+++-- | Convert to native path separators, namely @\\@ on Windows.+toNative :: FilePath -> FilePath+toNative = if isWindows then map (\x -> if x == '/' then '\\' else x) else id++-- | Convert all path separators to @/@, even on Windows.+toStandard :: FilePath -> FilePath+toStandard = if isWindows then map (\x -> if x == '\\' then '/' else x) else id+++-- | The extension of executables, @\"exe\"@ on Windows and @\"\"@ otherwise.+exe :: String+exe = if isWindows then "exe" else ""
+ src/Development/Shake/Forward.hs view
@@ -0,0 +1,173 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable, Rank2Types, ScopedTypeVariables, ViewPatterns #-}+{-# LANGUAGE TypeFamilies #-}++-- | A module for producing forward-defined build systems, in contrast to standard backwards-defined+--   build systems such as shake. Based around ideas from <https://code.google.com/p/fabricate/ fabricate>.+--   As an example:+--+-- @+-- import "Development.Shake"+-- import "Development.Shake.Forward"+-- import "Development.Shake.FilePath"+--+-- main = 'shakeArgsForward' 'shakeOptions' $ do+--     contents <- 'readFileLines' \"result.txt\"+--     'cache' $ 'cmd' \"tar -cf result.tar\" contents+-- @+--+--   Compared to backward-defined build systems (such as normal Shake), forward-defined build+--   systems tend to be simpler for simple systems (less boilerplate, more direct style), but more+--   complex for larger build systems (requires explicit parallelism, explicit sharing of build products,+--   no automatic command line targets). As a general approach for writing forward-defined systems:+--+-- * Figure out the sequence of system commands that will build your project.+--+-- * Write a simple 'Action' that builds your project.+--+-- * Insert 'cache' in front of most system commands.+--+-- * Replace most loops with 'forP', where they can be executed in parallel.+--+-- * Where Haskell performs real computation, if zero-build performance is insufficient, use 'cacheAction'.+--+--   All forward-defined systems use 'AutoDeps', which requires @fsatrace@ to be on the @$PATH@.+--   You can obtain @fsatrace@ from <https://github.com/jacereda/fsatrace>. You must set+--   'shakeLintInside' to specify where 'AutoDeps' will look for dependencies - if you want all dependencies+--   everywhere use @[\"\"]@.+--+--   This module is considered experimental - it has not been battle tested. There are now a few possible+--   alternatives in this space:+--+-- * Pier <http://hackage.haskell.org/package/pier/docs/Pier-Core-Artifact.html> (built on Shake).+--+-- * Rattle <https://github.com/ndmitchell/rattle> (by the same author as Shake).+--+-- * Stroll <https://github.com/snowleopard/stroll>.+module Development.Shake.Forward(+    shakeForward, shakeArgsForward,+    forwardOptions, forwardRule,+    cache, cacheAction, cacheActionWith,+    ) where++import Control.Monad+import Development.Shake+import Development.Shake.Rule+import Development.Shake.Command+import Development.Shake.Classes+import Development.Shake.FilePath+import Data.IORef.Extra+import Data.Either+import Data.Typeable+import Data.List.Extra+import Control.Exception.Extra+import Numeric+import System.IO.Unsafe+import Data.Binary+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS+import qualified Data.HashMap.Strict as Map+++{-# NOINLINE forwards #-}+forwards :: IORef (Map.HashMap Forward (Action Forward))+forwards = unsafePerformIO $ newIORef Map.empty++-- I'd like to use TypeRep, but it doesn't have any instances in older versions+newtype Forward = Forward (String, String, BS.ByteString) -- the type, the Show, the payload+    deriving (Hashable,Typeable,Eq,NFData,Binary)++mkForward :: (Typeable a, Show a, Binary a) => a -> Forward+mkForward x = Forward (show $ typeOf x, show x, encode' x)++unForward :: forall a . (Typeable a, Binary a) => Forward -> a+unForward (Forward (got,_,x))+    | got /= want = error $ "Failed to match forward type, wanted " ++ show want ++ ", got " ++ show got+    | otherwise = decode' x+    where want = show $ typeRep (Proxy :: Proxy a)++encode' :: Binary a => a -> BS.ByteString+encode' = BS.concat . LBS.toChunks . encode++decode' :: Binary a => BS.ByteString -> a+decode' = decode . LBS.fromChunks . pure++type instance RuleResult Forward = Forward++instance Show Forward where+    show (Forward (_,x,_)) = x++-- | Run a forward-defined build system.+shakeForward :: ShakeOptions -> Action () -> IO ()+shakeForward opts act = shake (forwardOptions opts) (forwardRule act)++-- | Run a forward-defined build system, interpreting command-line arguments.+shakeArgsForward :: ShakeOptions -> Action () -> IO ()+shakeArgsForward opts act = shakeArgs (forwardOptions opts) (forwardRule act)++-- | Given an 'Action', turn it into a 'Rules' structure which runs in forward mode.+forwardRule :: Action () -> Rules ()+forwardRule act = do+    opts <- getShakeOptionsRules+    when (null $ shakeLintInside opts) $+        fail "When running in forward mode you must set shakeLintInside to specify where to detect dependencies"+    addBuiltinRule noLint noIdentity $ \k old mode ->+        case old of+            Just old | mode == RunDependenciesSame -> pure $ RunResult ChangedNothing old (decode' old)+            _ -> do+                res <- liftIO $ atomicModifyIORef forwards $ \mp -> (Map.delete k mp, Map.lookup k mp)+                case res of+                    Nothing -> liftIO $ errorIO $ "Failed to find action name, " ++ show k+                    Just act -> do+                        new <- act+                        pure $ RunResult ChangedRecomputeSame (encode' new) new+    action act++-- | Given a 'ShakeOptions', set the options necessary to execute in forward mode.+forwardOptions :: ShakeOptions -> ShakeOptions+forwardOptions opts = opts{shakeCommandOptions=[AutoDeps]}+++-- | Cache an action, given a key and an 'Action'. Each call in your program should specify a different+--   key, but the key should remain consistent between runs. Ideally, the 'Action' will gather all its dependencies+--   with tracked operations, e.g. 'readFile\''. However, if information is accessed from the environment+--   (e.g. the action is a closure), you should call 'cacheActionWith' being explicit about what is captured.+cacheAction :: (Typeable a, Binary a, Show a, Typeable b, Binary b, Show b) => a -> Action b -> Action b+cacheAction (mkForward -> key) (action :: Action b) = do+    liftIO $ atomicModifyIORef_ forwards $ Map.insert key (mkForward <$> action)+    res <- apply1 key+    liftIO $ atomicModifyIORef_ forwards $ Map.delete key+    pure $ unForward res++newtype With a = With a+    deriving (Typeable, Binary, Show)++-- | Like 'cacheAction', but also specify which information is captured by the closure of the 'Action'. If that+--   information changes, the 'Action' will be rerun.+cacheActionWith :: (Typeable a, Binary a, Show a, Typeable b, Binary b, Show b, Typeable c, Binary c, Show c) => a -> b ->  Action c -> Action c+cacheActionWith key argument action = do+    cacheAction (With argument) $ do+        alwaysRerun+        pure argument+    cacheAction key $ do+        apply1 $ mkForward $ With argument+        action++-- | Apply caching to an external command using the same arguments as 'cmd'.+--+-- > cache $ cmd "gcc -c" ["foo.c"] "-o" ["foo.o"]+--+--   This command will be cached, with the inputs/outputs traced. If any of the+--   files used by this command (e.g. @foo.c@ or header files it imports) then+--   the command will rerun.+cache :: (forall r . CmdArguments r => r) -> Action ()+cache cmd = do+    let CmdArgument args = cmd+    let isDull ['-',_] = True; isDull _ = False+    let name = headDef "unknown" $ filter (not . isDull) $ drop1 $ rights args+    cacheAction (Command $ toStandard name ++ " #" ++ upper (showHex (abs $ hash $ show args) "")) cmd++newtype Command = Command String+    deriving (Typeable, Binary)++instance Show Command where+    show (Command x) = "command " ++ x
+ src/Development/Shake/Internal/Args.hs view
@@ -0,0 +1,423 @@+{-# LANGUAGE TupleSections #-}++-- | Command line parsing flags.+module Development.Shake.Internal.Args(+    shakeOptDescrs,+    shake,+    shakeArgs, shakeArgsWith, shakeArgsOptionsWith+    ) where++import Development.Shake.Internal.Paths+import Development.Shake.Internal.Options+import Development.Shake.Internal.Core.Rules+import Development.Shake.Internal.Errors+import Development.Shake.Internal.CompactUI+import Development.Shake.Internal.Demo+import Development.Shake.Internal.Core.Action+import Development.Shake.FilePath+import Development.Shake.Internal.Rules.File+import Development.Shake.Internal.Progress+import Development.Shake.Database+import General.Timing+import General.Extra+import General.Thread+import General.GetOpt+import General.EscCodes++import Data.Tuple.Extra+import Control.DeepSeq+import Control.Exception.Extra+import Control.Monad+import Data.Either+import Data.List.Extra+import Data.Maybe+import System.Directory.Extra+import System.Environment+import System.Exit+import System.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 = do+    addTiming "Function shake"+    (_, after) <- shakeWithDatabase opts rules $ \db -> do+        shakeOneShotDatabase 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+    where f _ files = pure $ Just $ if null files then rules else want 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 overridden by command line flags.+--   This argument is usually 'shakeOptions', perhaps with a few fields overridden.+--+-- * @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 -> pure $ 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 (Either String a)] -> ([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 (Either String a)]+    -> (ShakeOptions -> [a] -> [String] -> IO (Maybe (ShakeOptions, Rules ())))+    -> IO ()+shakeArgsOptionsWith baseOpts userOptions rules = do+    addTiming "shakeArgsWith"+    let baseOpts2 = removeOverlap userOptions $ map snd shakeOptsEx+    args <- getArgs+    let (flag1,files,errs) = getOpt (baseOpts2 `mergeOptDescr` userOptions) args+        (self,user) = partitionEithers flag1+        (flagsExtra,flagsShake) = first concat $ unzip self+        progressReplays = [x | ProgressReplay x <- flagsExtra]+        progressRecords = [x | ProgressRecord x <- flagsExtra]+        changeDirectory = listToMaybe [x | ChangeDirectory x <- flagsExtra]+        printDirectory = lastDef False [x | PrintDirectory x <- flagsExtra]+        shareRemoves = [x | ShareRemove x <- flagsExtra]+        oshakeOpts = foldl' (flip ($)) baseOpts flagsShake+    lintInside <- mapM canonicalizePath $ shakeLintInside oshakeOpts+    let shakeOpts = oshakeOpts {shakeLintInside = map (toStandard . addTrailingPathSeparator) lintInside+                               ,shakeLintIgnore = map toStandard $ shakeLintIgnore oshakeOpts+                               ,shakeOutput     = if shakeColor oshakeOpts+                                                  then outputColor (shakeOutput oshakeOpts)+                                                  else shakeOutput oshakeOpts+                               }+    let putWhen v msg = when (shakeVerbosity oshakeOpts >= v) $ shakeOutput oshakeOpts v msg+    let putWhenLn v msg = putWhen v $ msg ++ "\n"+    let showHelp long = do+            progName <- getProgName+            (targets, helpSuffix) <- if not long then pure ([], []) else+                handleSynchronous (\e -> do putWhenLn Info $ "Failure to collect targets: " ++ show e; pure ([], [])) $ do+                    -- run the rules as simply as we can+                    rs <- rules shakeOpts [] []+                    case rs of+                        Just (_, rs) -> do+                            xs <- getTargets shakeOpts rs+                            helpSuffix <- getHelpSuffix shakeOpts rs+                            evaluate $ force (["  - " ++ a ++ maybe "" (" - " ++) b | (a,b) <- xs], helpSuffix)+                        _ -> pure ([], [])+            changes<- pure $+                let as = shakeOptionsFields baseOpts+                    bs = shakeOptionsFields oshakeOpts+                in ["  - " ++ lbl ++ ": " ++ v1 ++ " => " ++ v2 | long, ((lbl, v1), (_, v2)) <- zip as bs, v1 /= v2]++            putWhen Error $ unlines $+                ("Usage: " ++ progName ++ " [options] [target] ...") :+                (if null baseOpts2 then [] else "" : (if null userOptions then "Options:" else "Standard options:") : showOptDescr baseOpts2) +++                (if null userOptions then [] else "" : "Extra options:" : showOptDescr userOptions) +++                (if null changes then [] else "" : "Changed ShakeOptions:" : changes) +++                (if null targets then [] else "" : "Targets:" : targets) +++                (if null helpSuffix then [] else "" : helpSuffix)++    when (errs /= []) $ do+        putWhen Error $ unlines $ map ("shake: " ++) $ filter (not . null) $ lines $ unlines errs+        showHelp False+        exitFailure++    if Help `elem` flagsExtra then+        showHelp True+     else if Version `elem` flagsExtra then+        putWhenLn Info $ "Shake build system, version " ++ shakeVersionString+     else if NumericVersion `elem` flagsExtra then+        putWhenLn Info shakeVersionString+     else if Demo `elem` flagsExtra then+        demo $ shakeStaunch shakeOpts+     else if not $ null progressReplays then do+        dat <- forM progressReplays $ \file -> do+            src <- readFile file+            pure (file, map read $ lines src)+        forM_ (if null $ shakeReport shakeOpts then ["-"] else shakeReport shakeOpts) $ \file -> do+            putWhenLn Info $ "Writing report to " ++ file+            writeProgressReport file dat+     else do+        when (Sleep `elem` flagsExtra) $ sleep 1+        start <- offsetTime+        initDataDirectory -- must be done before we start changing directory+        let redir = maybe id withCurrentDirectory changeDirectory+        shakeOpts <- if null progressRecords then pure shakeOpts else do+            t <- offsetTime+            pure shakeOpts{shakeProgress = \p ->+                void $ withThreadsBoth (shakeProgress shakeOpts p) $+                    progressDisplay 1 (const $ pure ()) $ do+                        p <- p+                        t <- t+                        forM_ progressRecords $ \file ->+                            appendFile file $ show (t,p) ++ "\n"+                        pure p+            }+        (ran,shakeOpts,res) <- redir $ do+            when printDirectory $ do+                curdir <- getCurrentDirectory+                putWhenLn Info $ "shake: In directory `" ++ curdir ++ "'"+            (shakeOpts, ui) <- do+                let compact = lastDef No [x | Compact x <- flagsExtra]+                use <- if compact == Auto then checkEscCodes else pure $ compact == Yes+                if use+                    then second withThreadSlave <$> compactUI shakeOpts+                    else pure (shakeOpts, id)+            rules <- rules shakeOpts user files+            ui $ case rules of+                Nothing -> pure (False, shakeOpts, Right ())+                Just (shakeOpts, rules) -> do+                    res <- try_ $ shake shakeOpts $+                        if NoBuild `elem` flagsExtra then+                            withoutActions rules+                        else if ShareList `elem` flagsExtra ||+                                not (null shareRemoves) ||+                                ShareSanity `elem` flagsExtra then do+                            action $ do+                                unless (null shareRemoves) $+                                    actionShareRemove shareRemoves+                                when (ShareList `elem` flagsExtra)+                                    actionShareList+                                when (ShareSanity `elem` flagsExtra)+                                    actionShareSanity+                            withoutActions rules+                        else+                            rules+                    pure (True, shakeOpts, res)++        if not ran || shakeVerbosity shakeOpts < Info || NoTime `elem` flagsExtra then+            either throwIO pure res+         else+            let esc = if shakeColor shakeOpts then escape else \_ x -> x+            in case res of+                Left err ->+                    if Exception `elem` flagsExtra then+                        throwIO err+                    else do+                        putWhenLn Error $ esc Red $ show err+                        exitFailure+                Right () -> do+                    tot <- start+                    putWhenLn Info $ esc Green $ "Build completed in " ++ showDuration tot+++-- | 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 (Either String (ShakeOptions -> ShakeOptions))]+shakeOptDescrs = [fmapFmapOptDescr snd o | (True, o) <- shakeOptsEx]++data Extra = ChangeDirectory FilePath+           | Version+           | NumericVersion+           | PrintDirectory Bool+           | Help+           | Sleep+           | NoTime+           | Exception+           | NoBuild+           | ProgressRecord FilePath+           | ProgressReplay FilePath+           | Demo+           | ShareList+           | ShareSanity+           | ShareRemove String+           | Compact Auto+             deriving Eq++data Auto = Yes | No | Auto+    deriving Eq++escape :: Color -> String -> String+escape color x = escForeground color ++ x ++ escNormal++outputColor :: (Verbosity -> String -> IO ()) -> Verbosity -> String -> IO ()+outputColor output v msg = output v $ color msg+  where color = case v of+            Silent -> id+            Error  -> escape Red+            Warn   -> escape Yellow+            _      -> escape Blue++-- | True if it has a potential effect on ShakeOptions+shakeOptsEx :: [(Bool, OptDescr (Either String ([Extra], ShakeOptions -> ShakeOptions)))]+shakeOptsEx =+    [opts $ Option "a" ["abbrev"] (reqArgPair "abbrev" "FULL=SHORT" $ \a s -> s{shakeAbbreviations=shakeAbbreviations s ++ [a]}) "Use abbreviation in status messages."+    ,opts $ Option ""  ["allow-redefine-rules"] (noArg $ \s -> s{shakeAllowRedefineRules = True}) "Allow redefining built-in rules"+    ,opts $ Option ""  ["no-allow-redefine-rules"] (noArg $ \s -> s{shakeAllowRedefineRules = False}) "Forbid redefining built-in rules (default)"+    ,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 (shakeOutput s) 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=Just i})) "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=fromMaybe 0 i}) "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=Just LintBasic}) "Perform limited validation after the run."+    ,opts $ Option ""  ["lint-watch"] (reqArg "PATTERN" $ \x s -> s{shakeLintWatch=shakeLintWatch s ++ [x]}) "Error if any of the patterns are created (expensive)."+    ,opts $ Option ""  ["lint-fsatrace"] (optArg "DIR" $ \x s -> s{shakeLint=Just LintFSATrace, shakeLintInside=shakeLintInside s ++ [fromMaybe "." x]}) "Use fsatrace to do validation [in current dir]."+    ,opts $ Option ""  ["lint-ignore"] (reqArg "PATTERN" $ \x s -> s{shakeLintIgnore=shakeLintIgnore s ++ [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=shakeLiveFiles s ++ [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=shakeRebuild s ++ [(RebuildNow, fromMaybe "**" x)]}) "If required, these files will rebuild even if nothing has changed."+    ,opts $ Option ""  ["no-rebuild"] (optArg "PATTERN" $ \x s -> s{shakeRebuild=shakeRebuild s ++ [(RebuildNormal, fromMaybe "**" x)]}) "If required, these files will rebuild only if things have changed (default)."+    ,opts $ Option ""  ["skip"] (optArg "PATTERN" $ \x s -> s{shakeRebuild=shakeRebuild s ++ [(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=shakeReport s ++ [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 $ shakeChange s}) "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 $ fromMaybe 5 i}) "Show progress messages [every N secs, default 5]."+    ,opts $ Option ""  ["no-progress"] (noArg $ \s -> s{shakeProgress=const $ pure ()}) "Don't show progress messages."+    ,opts $ Option "q" ["quiet"] (noArg $ \s -> s{shakeVerbosity=move (shakeVerbosity s) 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 (shakeVerbosity s) 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."+    ]+    where+        opts 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 way++        move :: Verbosity -> (Int -> Int) -> Verbosity+        move x by = toEnum $ min (fromEnum mx) $ max (fromEnum mn) $ by $ fromEnum x+            where (mn,mx) = (asTypeOf minBound x, asTypeOf maxBound x)++        noArg = NoArg . Right+        reqArg a f = ReqArg (Right . f) a+        optArg a f = OptArg (Right . f) a++        reqIntArg mn flag a f = flip ReqArg a $ \x -> case reads x of+            [(i,"")] | i >= mn -> Right (f i)+            _ -> Left $ "the `--" ++ flag ++ "' option requires a number, " ++ show mn ++ " or above"++        optArgInt mn flag a f = flip OptArg a $ maybe (Right (f Nothing)) $ \x -> case reads x of+            [(i,"")] | i >= mn -> Right (f $ Just i)+            _ -> Left $ "the `--" ++ flag ++ "' option requires a number, " ++ show mn ++ " or above"++        optArgAuto flag a f = flip OptArg a $ maybe (Right (f Yes)) $ \x -> case x of+            "yes" -> Right $ f Yes+            "no" -> Right $ f No+            "auto" -> Right $ f Auto+            _ -> Left $ "the `--" ++ flag ++ "' option requires yes|no|auto, but got " ++ show x++        reqArgPair flag a f = flip ReqArg a $ \x -> case break (== '=') x of+            (a,'=':b) -> Right $ f (a,b)+            _ -> Left $ "the `--" ++ flag ++ "' option requires an = in the argument"++        progress (OptArg func msg) = flip OptArg msg $ \x -> case break (== '=') `fmap` x of+            Just ("record",file) -> Right ([ProgressRecord $ if null file then "progress.txt" else tailErr file], id)+            Just ("replay",file) -> Right ([ProgressReplay $ if null file then "progress.txt" else tailErr file], id)+            _ -> ([],) <$> func x+        progress _ = throwImpure $ errorInternal "incomplete pattern, progress"++        outputDebug output Nothing = output+        outputDebug output (Just file) = \v msg -> do+            when (v /= Diagnostic) $ output v msg+            appendFile file $ removeEscCodes msg ++ "\n"++        prog i p = do+            program <- progressProgram+            progressDisplay i (\s -> progressTitlebar s >> program s) p++        -- ensure the file system always computes a hash, required for --share+        ensureHash ChangeModtime = ChangeModtimeAndDigest+        ensureHash ChangeModtimeAndDigestInput = ChangeModtimeAndDigest+        ensureHash x = x++        ensureShare s = s{shakeShare = Just $ fromMaybe "." $ shakeShare s}
+ src/Development/Shake/Internal/CmdOption.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE DeriveDataTypeable #-}+module Development.Shake.Internal.CmdOption(CmdOption(..)) where++import Data.Data+import qualified Data.ByteString.Lazy.Char8 as LBS++-- | Options passed to 'command' or 'cmd' to control how processes are executed.+data CmdOption+    = Cwd FilePath -- ^ Change the current directory in the spawned process. By default uses this processes current directory.+                   --   Successive 'Cwd' options are joined together, to change into nested directories.+    | Env [(String,String)] -- ^ Change the environment variables in the spawned process. By default uses this processes environment.+    | AddEnv String String -- ^ Add an environment variable in the child process.+    | RemEnv String -- ^ Remove an environment variable from the child process.+    | AddPath [String] [String] -- ^ Add some items to the prefix and suffix of the @$PATH@ variable.+    | Stdin String -- ^ Given as the @stdin@ of the spawned process.+    | StdinBS LBS.ByteString -- ^ Given as the @stdin@ of the spawned process.+    | FileStdin FilePath -- ^ Take the @stdin@ from a file.+    | Shell -- ^ Pass the command to the shell without escaping - any arguments will be joined with spaces. By default arguments are escaped properly.+    | BinaryPipes -- ^ Treat the @stdin@\/@stdout@\/@stderr@ messages as binary. By default 'String' results use text encoding and 'ByteString' results use binary encoding.+    | Traced String -- ^ Name to use with 'traced', or @\"\"@ for no tracing. By default traces using the name of the executable.+    | Timeout Double -- ^ Abort the computation after N seconds, will raise a failure exit code. Calls 'interruptProcessGroupOf' and 'terminateProcess', but may sometimes fail to abort the process and not timeout.+    | WithStdout Bool -- ^ Should I include the @stdout@ in the exception if the command fails? Defaults to 'False'.+    | WithStderr Bool -- ^ Should I include the @stderr@ in the exception if the command fails? Defaults to 'True'.+    | EchoStdout Bool -- ^ Should I echo the @stdout@? Defaults to 'True' unless a 'Stdout' result is required or you use 'FileStdout'.+    | EchoStderr Bool -- ^ Should I echo the @stderr@? Defaults to 'True' unless a 'Stderr' result is required or you use 'FileStderr'.+    | FileStdout FilePath -- ^ Should I put the @stdout@ to a file.+    | FileStderr FilePath -- ^ Should I put the @stderr@ to a file.+    | AutoDeps -- ^ Compute dependencies automatically. Only works if 'shakeLintInside' has been set to the files where autodeps might live.+    | UserCommand String -- ^ The command the user thinks about, before any munging. Defaults to the actual command.+    | FSAOptions String -- ^ Options to @fsatrace@, a list of strings with characters such as @\"r\"@ (reads) @\"w\"@ (writes). Defaults to @\"rwmdqt\"@ if the output of @fsatrace@ is required.+    | CloseFileHandles -- ^ Before starting the command in the child process, close all file handles except stdin, stdout, stderr in the child process. Uses @close_fds@ from package process and comes with the same caveats, i.e. runtime is linear with the maximum number of open file handles (@RLIMIT_NOFILE@, see @man 2 getrlimit@ on Linux).+    | NoProcessGroup -- ^ Don't run the process in its own group. Required when running @docker@. Will mean that process timeouts and asyncronous exceptions may not properly clean up child processes.+    | InheritStdin -- ^ Cause the stdin from the parent to be inherited. Might also require NoProcessGroup on Linux. Ignored if you explicitly pass a stdin.+      deriving (Eq,Ord,Show,Data,Typeable)
+ src/Development/Shake/Internal/CompactUI.hs view
@@ -0,0 +1,77 @@++-- | Provide a Buck/Bazel style UI.+module Development.Shake.Internal.CompactUI(+    compactUI+    ) where++import Development.Shake.Internal.CmdOption+import Development.Shake.Internal.Options+import Development.Shake.Internal.Progress++import System.Time.Extra+import General.Extra+import Control.Exception+import General.Thread+import General.EscCodes+import Data.IORef.Extra+import Control.Monad.Extra+++data S = S+    {sOutput :: [String] -- ^ Messages that haven't yet been printed, in reverse.+    ,sProgress :: String -- ^ Last progress message.+    ,sTraces :: [Maybe (String, String, Seconds)] -- ^ the traced items, in the order we display them+    ,sUnwind :: Int -- ^ Number of lines we used last time around+    }++emptyS = S [] "Starting..." [] 0++addOutput pri msg s = s{sOutput = msg : sOutput s}+addProgress x s = s{sProgress = x}++addTrace key msg start time s+    | start = s{sTraces = insert (key,msg,time) $ sTraces s}+    | otherwise = s{sTraces = remove (\(a,b,_) -> a == key && b == msg) $ sTraces s}+    where+        insert v (Nothing:xs) = Just v:xs+        insert v (x:xs) = x : insert v xs+        insert v [] = [Just v]++        remove f (Just x:xs) | f x = Nothing:xs+        remove f (x:xs) = x : remove f xs+        remove f [] = []+++display :: Seconds -> S -> (S, String)+display time s = (s{sOutput=[], sUnwind=length post}, escCursorUp (sUnwind s) ++ unlines (map pad $ pre ++ post))+    where+        pre = sOutput s+        post = "" : (escForeground Green ++ "Status: " ++ sProgress s ++ escNormal) : map f (sTraces s)++        pad x = x ++ escClearLine+        f Nothing = " *"+        f (Just (k,m,t)) = " * " ++ k ++ " (" ++ g (time - t) m ++ ")"++        g i m | showDurationSecs i == "0s" = m+              | i < 10 = s+              | otherwise = escForeground (if i > 20 then Red else Yellow) ++ s ++ escNormal+            where s = m ++ " " ++ showDurationSecs i+++-- | Run a compact UI, with the ShakeOptions modifier, combined with+compactUI :: ShakeOptions -> IO (ShakeOptions, IO ())+compactUI opts = do+    unlessM checkEscCodes $+        putStrLn "Your terminal does not appear to support escape codes, --compact mode may not work"+    ref <- newIORef emptyS+    let tweak = atomicModifyIORef_ ref+    time <- offsetTime+    opts <- pure $ opts+        {shakeTrace = \a b c -> do t <- time; tweak (addTrace a b c t)+        ,shakeOutput = \a b -> tweak (addOutput a b)+        ,shakeProgress = \x -> void $ progressDisplay 1 (tweak . addProgress) x `withThreadsBoth` shakeProgress opts x+        ,shakeCommandOptions = [EchoStdout False, EchoStderr False] ++ shakeCommandOptions opts+        ,shakeVerbosity = Error+        }+    let tick = do t <- time; mask_ $ putStr =<< atomicModifyIORef ref (display t)+    pure (opts, forever (tick >> sleep 0.4) `finally` tick)
+ src/Development/Shake/Internal/Core/Action.hs view
@@ -0,0 +1,639 @@+{-# LANGUAGE RecordWildCards, NamedFieldPuns, ScopedTypeVariables, ConstraintKinds, TupleSections #-}++module Development.Shake.Internal.Core.Action(+    actionOnException, actionFinally, actionBracket, actionCatch, actionRetry,+    getShakeOptions, getProgress, runAfter,+    lintTrackRead, lintTrackWrite, lintTrackAllow,+    getVerbosity, putWhen, putVerbose, putInfo, putWarn, putError, withVerbosity, quietly,+    orderOnlyAction,+    newCacheIO,+    unsafeExtraThread,+    parallel,+    batch,+    reschedule,+    historyDisable,+    traced,+    -- Internal only+    producesChecked, producesUnchecked, producesCheck, lintCurrentDirectory, lintWatch,+    blockApply, unsafeAllowApply, shakeException, lintTrackFinished,+    getCurrentKey, getLocal,+    actionShareList, actionShareRemove, actionShareSanity+    ) where++import Control.Exception+import Control.Monad.Extra+import Control.Monad.IO.Class+import Control.DeepSeq+import Data.Typeable+import System.Directory+import System.FilePattern+import System.FilePattern.Directory+import System.Time.Extra+import Control.Concurrent.Extra+import Data.Maybe+import Data.Tuple.Extra+import Data.IORef.Extra+import Data.List.Extra+import Numeric.Extra+import General.Extra+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set++import Development.Shake.Classes+import Development.Shake.Internal.Core.Monad+import Development.Shake.Internal.Core.Database+import Development.Shake.Internal.History.Shared+import General.Pool+import Development.Shake.Internal.Core.Types+import Development.Shake.Internal.Core.Rules+import Development.Shake.Internal.Core.Pool+import Development.Shake.Internal.Value+import Development.Shake.Internal.FileInfo+import Development.Shake.Internal.FileName+import Development.Shake.Internal.Options+import Development.Shake.Internal.Errors+import General.Cleanup+import General.Fence+++---------------------------------------------------------------------+-- RAW WRAPPERS++-- | Apply a modification, run an action, then run an undo action after.+--   Doesn't actually require exception handling because we don't have the ability to catch exceptions to the user.+actionThenUndoLocal :: (Local -> (Local, Local -> Local)) -> Action a -> Action a+actionThenUndoLocal f m = Action $ do+    s <- getRW+    let (s2,undo) = f s+    putRW s2+    res <- fromAction m+    modifyRW undo+    pure res+++---------------------------------------------------------------------+-- EXCEPTION HANDLING++-- | Turn a normal exception into a ShakeException, giving it a stack and printing it out if in staunch mode.+--   If the exception is already a ShakeException (e.g. it's a child of ours who failed and we are rethrowing)+--   then do nothing with it.+shakeException :: Global -> Stack -> SomeException -> IO ShakeException+shakeException Global{globalOptions=ShakeOptions{..},..} stk e = case fromException e of+    Just (e :: ShakeException) -> pure e+    Nothing -> do+        e<- pure $ exceptionStack stk e+        when (shakeStaunch && shakeVerbosity >= Error) $+            globalOutput Error $ show e ++ "Continuing due to staunch mode"+        pure e+++actionBracketEx :: Bool -> IO a -> (a -> IO b) -> (a -> Action c) -> Action c+actionBracketEx runOnSuccess alloc free act = do+    Global{..} <- Action getRO+    (v, key) <- liftIO $ mask_ $ do+        v <- alloc+        key <- liftIO $ register globalCleanup $ void $ free v+        pure (v, key)+    res <- Action $ catchRAW (fromAction $ act v) $ \e -> liftIO (release key) >> throwRAW e+    liftIO $ if runOnSuccess then release key else unprotect key+    pure res++-- | If an exception is raised by the 'Action', perform some 'IO' then reraise the exception.+--   This function is implemented using 'actionBracket'.+actionOnException :: Action a -> IO b -> Action a+actionOnException act free = actionBracketEx False (pure ()) (const free) (const act)++-- | After an 'Action', perform some 'IO', even if there is an exception.+--   This function is implemented using 'actionBracket'.+actionFinally :: Action a -> IO b -> Action a+actionFinally act free = actionBracket (pure ()) (const free) (const act)++-- | Like 'bracket', but where the inner operation is of type 'Action'. Usually used as+--   @'actionBracket' alloc free use@.+--+--   The @free@ action will be run masked. The cost of 'actionBracket' is _O(n log n)_+--   in the number of simultaneous 'actionBracket' calls active in the program.+actionBracket :: IO a -> (a -> IO b) -> (a -> Action c) -> Action c+actionBracket = actionBracketEx True+++-- | If a syncronous exception is raised by the 'Action', perform some handler.+--   Note that there is no guarantee that the handler will run on shutdown (use 'actionFinally' for that),+--   and that 'actionCatch' /cannot/ catch exceptions thrown by dependencies, e.g. raised by 'need'+--   (to do so would allow untracked dependencies on failure conditions).+actionCatch :: Exception e => Action a -> (e -> Action a) -> Action a+actionCatch act hdl = Action $ catchRAW (fromAction act) $ \e ->+    case () of+        _ | not $ isAsyncException e+          , Nothing <- fromException e :: Maybe ShakeException+          , Just e <- fromException e+          -> fromAction $ hdl e+        _ -> throwRAW e+++-- | Retry an 'Action' if it throws an exception, at most /n/ times (where /n/ must be positive).+--   If you need to call this function, you should probably try and fix the underlying cause (but you also probably know that).+actionRetry :: Int -> Action a -> Action a+actionRetry i act+    | i <= 0 = fail $ "actionRetry first argument must be positive, got " ++ show i+    | i == 1 = act+    | otherwise = Action $ catchRAW (fromAction act) $ \_ -> fromAction $ actionRetry (i-1) act+++---------------------------------------------------------------------+-- QUERIES++-- | Get the initial 'ShakeOptions', these will not change during the build process.+getShakeOptions :: Action ShakeOptions+getShakeOptions = Action $ globalOptions <$> getRO+++-- | Get the current 'Progress' structure, as would be returned by 'shakeProgress'.+getProgress :: Action Progress+getProgress = do+    Global{..} <- Action getRO+    liftIO globalProgress++-- | Specify an action to be run after the database has been closed, if building completes successfully.+runAfter :: IO () -> Action ()+runAfter op = do+    Global{..} <- Action getRO+    liftIO $ atomicModifyIORef_ globalAfter (op:)+++---------------------------------------------------------------------+-- VERBOSITY++putWhen :: Verbosity -> String -> Action ()+putWhen v msg = do+    Global{..} <- Action getRO+    verb <- getVerbosity+    when (verb >= v) $+        liftIO $ globalOutput v msg+++-- | Write an unimportant message to the output, only shown when 'shakeVerbosity' is higher than normal ('Verbose' or above).+--   The output will not be interleaved with any other Shake messages (other than those generated by system commands).+putVerbose :: String -> Action ()+putVerbose = putWhen Verbose++-- | Write a normal priority message to the output, only suppressed when 'shakeVerbosity' is 'Error', 'Warn' or 'Silent'.+--   The output will not be interleaved with any other Shake messages (other than those generated by system commands).+putInfo :: String -> Action ()+putInfo = putWhen Info++-- | Write a semi important message to the output, only suppressed when 'shakeVerbosity' is 'Error' or 'Silent'.+--   The output will not be interleaved with any other Shake messages (other than those generated by system commands).+putWarn :: String -> Action ()+putWarn = putWhen Warn++-- | Write an important message to the output, only suppressed when 'shakeVerbosity' is 'Silent'.+--   The output will not be interleaved with any other Shake messages (other than those generated by system commands).+putError :: String -> Action ()+putError = putWhen Error+++-- | Get the current verbosity level, originally set by 'shakeVerbosity'. If you+--   want to output information to the console, you are recommended to use+--   'putVerbose' \/ 'putInfo' \/ 'putError', which ensures multiple messages are+--   not interleaved. The verbosity can be modified locally by 'withVerbosity'.+getVerbosity :: Action Verbosity+getVerbosity = Action $ localVerbosity <$> getRW+++-- | Run an action with a particular verbosity level.+--   Will not update the 'shakeVerbosity' returned by 'getShakeOptions' and will+--   not have any impact on 'Diagnostic' tracing.+withVerbosity :: Verbosity -> Action a -> Action a+withVerbosity new = actionThenUndoLocal $ \s0 ->+    (s0{localVerbosity=new}, \s -> s{localVerbosity=localVerbosity s0})+++-- | Run an action with 'Error' verbosity, in particular messages produced by 'traced'+--   (including from 'Development.Shake.cmd' or 'Development.Shake.command') will not be printed to the screen.+--   Will not update the 'shakeVerbosity' returned by 'getShakeOptions' and will+--   not turn off any 'Diagnostic' tracing.+quietly :: Action a -> Action a+quietly = withVerbosity Error+++---------------------------------------------------------------------+-- BLOCK APPLY++unsafeAllowApply :: Action a -> Action a+unsafeAllowApply  = applyBlockedBy Nothing++blockApply :: String -> Action a -> Action a+blockApply = applyBlockedBy . Just++applyBlockedBy :: Maybe String -> Action a -> Action a+applyBlockedBy reason = actionThenUndoLocal $ \s0 ->+    (s0{localBlockApply=reason}, \s -> s{localBlockApply=localBlockApply s0})+++---------------------------------------------------------------------+-- TRACING++-- | Write an action to the trace list, along with the start/end time of running the IO action.+--   The 'Development.Shake.cmd' and 'Development.Shake.command' functions automatically call 'traced'+--   with the name of the executable. The trace list is used for profile reports (see 'shakeReport').+--+--   By default 'traced' prints some useful extra context about what+--   Shake is building, e.g.:+--+-- > # traced message (for myobject.o)+--+--   To suppress the output of 'traced' (for example you want more control+--   over the message using 'putInfo'), use the 'quietly' combinator.+--+--   It is recommended that the string passed to 'traced' is short and that only a small number of unique strings+--   are used (makes profiling work better).+--   The string does not need to make sense on its own, only in conjunction with the target it is building.+traced :: String -> IO a -> Action a+traced msg act = do+    Global{..} <- Action getRO+    Local{localStack} <- Action getRW+    start <- liftIO globalTimestamp+    let key = showTopStack localStack+    putInfo $ "# " ++ msg ++ " (for " ++ key ++ ")"+    res <- liftIO $+        (shakeTrace globalOptions key msg True >> act)+            `finally` shakeTrace globalOptions key msg False+    stop <- liftIO globalTimestamp+    let trace = newTrace msg start stop+    liftIO $ evaluate $ rnf trace+    Action $ modifyRW $ \s -> s{localTraces = addTrace (localTraces s) trace}+    pure res+++---------------------------------------------------------------------+-- TRACKING++-- | Track that a key has been used/read by the action preceding it when 'shakeLint' is active.+lintTrackRead :: ShakeValue key => [key] -> Action ()+-- One of the following must be true:+-- 1) you are the one building this key (e.g. key == topStack)+-- 2) you have already been used by apply, and are on the dependency list+-- 3) someone explicitly gave you permission with trackAllow+-- 4) at the end of the rule, a) you are now on the dependency list, and b) this key itself has no dependencies (is source file)+lintTrackRead ks = do+    Global{..} <- Action getRO+    when (isJust $ shakeLint globalOptions) $ do+        l@Local{..} <- Action getRW+        deps <- liftIO $ concatMapM (listDepends globalDatabase) $ enumerateDepends localDepends+        let top = topStack localStack++        let condition1 k = top == Just k+        let condition2 k = k `elem` deps+        let condition3 k = any ($ k) localTrackAllows+        let condition4 = filter (\k -> not $ condition1 k || condition2 k || condition3 k) $ map newKey ks+        unless (null condition4) $+            Action $ putRW l{localTrackRead = condition4 ++ localTrackRead}+++-- | Track that a key has been changed/written by the action preceding it when 'shakeLint' is active.+lintTrackWrite :: ShakeValue key => [key] -> Action ()+-- One of the following must be true:+-- 1) you are the one building this key (e.g. key == topStack)+-- 2) someone explicitly gave you permission with trackAllow+-- 3) this file is never known to the build system, at the end it is not in the database+lintTrackWrite ks = do+    Global{..} <- Action getRO+    when (isJust $ shakeLint globalOptions) $ do+        l@Local{..} <- Action getRW+        let top = topStack localStack++        let condition1 k = Just k == top+        let condition2 k = any ($ k) localTrackAllows+        let condition3 = filter (\k -> not $ condition1 k || condition2 k) $ map newKey ks+        unless (null condition3) $+            Action $ putRW l{localTrackWrite = condition3 ++ localTrackWrite}+++lintTrackFinished :: Action ()+lintTrackFinished = do+    -- only called when isJust shakeLint+    Global{..} <- Action getRO+    Local{..} <- Action getRW+    liftIO $ do+        let top = topStack localStack+        -- must apply the ignore at the end, because we might have merged in more ignores that+        -- apply to other branches+        let ignore k = any ($ k) localTrackAllows++        -- Read stuff+        deps <- concatMapM (listDepends globalDatabase) $ enumerateDepends localDepends+        let used = Set.filter (not . ignore) $ Set.fromList localTrackRead++        -- check Read 4a+        bad<- pure $ Set.toList $ used `Set.difference` Set.fromList deps+        unless (null bad) $ do+            let n = length bad+            throwM $ errorStructured+                ("Lint checking error - " ++ (if n == 1 then "value was" else show n ++ " values were") ++ " used but not depended upon")+                [("Used", Just $ show x) | x <- bad]+                ""++        -- check Read 4b+        bad <- flip filterM (Set.toList used) $ \k -> not . null <$> lookupDependencies globalDatabase k+        unless (null bad) $ do+            let n = length bad+            throwM $ errorStructured+                ("Lint checking error - " ++ (if n == 1 then "value was" else show n ++ " values were") ++ " depended upon after being used")+                [("Used", Just $ show x) | x <- bad]+                ""++        -- check Write 3+        bad<- pure $ filter (not . ignore) $ Set.toList $ Set.fromList localTrackWrite+        unless (null bad) $+            liftIO $ atomicModifyIORef_ globalTrackAbsent ([(fromMaybe k top, k) | k <- bad] ++)+++-- | Allow any matching key recorded with 'lintTrackRead' or 'lintTrackWrite' in this action,+--   after this call, to violate the tracking rules.+lintTrackAllow :: ShakeValue key => (key -> Bool) -> Action ()+lintTrackAllow (test :: key -> Bool) = do+    Global{..} <- Action getRO+    when (isJust $ shakeLint globalOptions) $+        Action $ modifyRW $ \s -> s{localTrackAllows = f : localTrackAllows s}+    where+        tk = typeRep (Proxy :: Proxy key)+        f k = typeKey k == tk && test (fromKey k)+++lintCurrentDirectory :: FilePath -> String -> IO ()+lintCurrentDirectory old msg = do+    now <- getCurrentDirectory+    when (old /= now) $ throwIO $ errorStructured+        "Lint checking error - current directory has changed"+        [("When", Just msg)+        ,("Wanted",Just old)+        ,("Got",Just now)]+        ""++lintWatch :: [FilePattern] -> IO (String -> IO ())+lintWatch [] = pure $ const $ pure ()+lintWatch pats = do+    let op = getDirectoryFiles "." pats -- cache parsing of the pats+    let record = do xs <- op; forM xs $ \x -> (x,) <$> getFileInfo False (fileNameFromString x)+    old <- record+    pure $ \msg -> do+        now <- record+        when (old /= now) $ throwIO $ errorStructured+            "Lint checking error - watched files have changed"+            (("When", Just msg) : changes (Map.fromList old) (Map.fromList now))+            ""+    where+        changes old now =+            [("Created", Just x) | x <- Map.keys $ Map.difference now old] +++            [("Deleted", Just x) | x <- Map.keys $ Map.difference old now] +++            [("Changed", Just x) | x <- Map.keys $ Map.filter id $ Map.intersectionWith (/=) old now]+++listDepends :: Database -> Depends -> IO [Key]+listDepends db (Depends xs) = mapM (fmap (fst . fromJust) . getKeyValueFromId db) xs+++lookupDependencies :: Database -> Key -> IO [Depends]+lookupDependencies db k = do+    Just (Ready r) <- getValueFromKey db k+    pure $ depends r+++-- | This rule should not be saved to shared/cloud storage via 'shakeShare'.+--   There are usually two reasons to call this function:+--+--   1. It makes use of untracked dependencies that are specific to this machine,+--      e.g. files in a system directory or items on the @$PATH@.+--   2. The rule is trivial to compute locally, so there is no point sharing it.+--+--   If you want the rule to not be cached at all, use 'alwaysRerun'.+historyDisable :: Action ()+historyDisable = Action $ modifyRW $ \s -> s{localHistory = False}+++-- | A version of 'produces' that checks the files actually exist+producesChecked :: [FilePath] -> Action ()+producesChecked xs = Action $ modifyRW $ \s -> s{localProduces = map (True,) (reverse xs) ++ localProduces s}++-- | A version of 'produces' that does not check.+producesUnchecked :: [FilePath] -> Action ()+producesUnchecked xs = Action $ modifyRW $ \s -> s{localProduces = map (False,) (reverse xs) ++ localProduces s}++producesCheck :: Action ()+producesCheck = do+    Local{localProduces} <- Action getRW+    missing <- liftIO $ filterM (notM . doesFileExist_) $ map snd $ filter fst localProduces+    when (missing /= []) $ throwM $ errorStructured+        "Files declared by 'produces' not produced"+        [("File " ++ show i, Just x) | (i,x) <- zipFrom 1 missing]+        ""+++-- | Run an action but do not depend on anything the action uses.+--   A more general version of 'orderOnly'.+orderOnlyAction :: Action a -> Action a+orderOnlyAction act = Action $ do+    Local{localDepends=pre} <- getRW+    res <- fromAction act+    modifyRW $ \s -> s{localDepends=pre}+    pure res+++---------------------------------------------------------------------+-- MORE COMPLEX++-- | A version of 'Development.Shake.newCache' that runs in IO, and can be called before calling 'Development.Shake.shake'.+--   Most people should use 'Development.Shake.newCache' instead.+newCacheIO :: (Eq k, Hashable k) => (k -> Action v) -> IO (k -> Action v)+newCacheIO (act :: k -> Action v) = do+    var :: Var (Map.HashMap k (Fence IO (Either SomeException (DependsList,v)))) <- newVar Map.empty+    pure $ \key ->+        join $ liftIO $ modifyVar var $ \mp -> case Map.lookup key mp of+            Just bar -> pure $ (,) mp $ do+                (offset, (deps, v)) <- actionFenceRequeue bar+                Action $ modifyRW $ \s -> addDiscount offset $ s{localDepends = addDepends (localDepends s) deps}+                pure v+            Nothing -> do+                bar <- newFence+                pure $ (Map.insert key bar mp,) $ do+                    Local{localDepends=pre} <- Action getRW+                    Action $ modifyRW $ \s -> s{localDepends = newDepends []}+                    res <- Action $ tryRAW $ fromAction $ act key+                    case res of+                        Left err -> do+                            liftIO $ signalFence bar $ Left err+                            Action $ throwRAW err+                        Right v -> do+                            Local{localDepends=deps} <- Action getRW+                            Action $ modifyRW $ \s -> s{localDepends = addDepends pre deps}+                            liftIO $ signalFence bar $ Right (deps, v)+                            pure v+++-- | Run an action without counting to the thread limit, typically used for actions that execute+--   on remote machines using barely any local CPU resources.+--   Unsafe as it allows the 'shakeThreads' limit to be exceeded.+--   You cannot depend on a rule (e.g. 'need') while the extra thread is executing.+--   If the rule blocks (e.g. calls 'withResource') then the extra thread may be used by some other action.+--   Only really suitable for calling 'cmd' / 'command'.+unsafeExtraThread :: Action a -> Action a+unsafeExtraThread act = do+    Global{..} <- Action getRO+    stop <- liftIO $ increasePool globalPool+    res <- Action $ tryRAW $ fromAction $ blockApply "Within unsafeExtraThread" act+    liftIO stop+    -- we start a new thread, giving up ours, to ensure the thread count goes down+    (wait, res) <- actionAlwaysRequeue res+    Action $ modifyRW $ addDiscount wait+    pure res+++-- | Execute a list of actions in parallel. In most cases 'need' will be more appropriate to benefit from parallelism.+--   If the two types of 'Action' are different dependencies which ultimately boil down to 'apply',+--   using 'Applicative' operations will still ensure the dependencies occur in parallel.+--   The main use of this function is to run work that happens in an 'Action' in parallel.+parallel :: [Action a] -> Action [a]+-- Note: There is no parallel_ unlike sequence_ because there is no stack benefit to doing so+parallel [] = pure []+parallel [x] = pure <$> x+parallel acts = do+    Global{..} <- Action getRO++    done <- liftIO $ newIORef False+    waits <- forM acts $ \act ->+        addPoolWait PoolResume $ do+            whenM (liftIO $ readIORef done) $+                fail "parallel, one has already failed"+            Action $ modifyRW localClearMutable+            res <- act+            old <- Action getRW+            pure (old, res)+    (wait, res) <- actionFenceSteal =<< liftIO (exceptFence waits)+    liftIO $ atomicWriteIORef done True+    let (waits, locals, results) = unzip3 $ map (\(a,(b,c)) -> (a,b,c)) res+    Action $ modifyRW $ \root -> addDiscount (wait - sum waits) $ localMergeMutable root locals+    pure results+++-- | Batch different outputs into a single 'Action', typically useful when a command has a high+--   startup cost - e.g. @apt-get install foo bar baz@ is a lot cheaper than three separate+--   calls to @apt-get install@. As an example, if we have a standard build rule:+--+-- @+-- \"*.out\" 'Development.Shake.%>' \\out -> do+--     'Development.Shake.need' [out '-<.>' \"in\"]+--     'Development.Shake.cmd' "build-multiple" [out '-<.>' \"in\"]+-- @+--+--   Assuming that @build-multiple@ can compile multiple files in a single run,+--   and that the cost of doing so is a lot less than running each individually,+--   we can write:+--+-- @+-- 'batch' 3 (\"*.out\" 'Development.Shake.%>')+--     (\\out -> do 'Development.Shake.need' [out '-<.>' \"in\"]; pure out)+--     (\\outs -> 'Development.Shake.cmd' "build-multiple" [out '-<.>' \"in\" | out \<- outs])+-- @+--+--   In constrast to the normal call, we have specified a maximum batch size of 3,+--   an action to run on each output individually (typically all the 'need' dependencies),+--   and an action that runs on multiple files at once. If we were to require lots of+--   @*.out@ files, they would typically be built in batches of 3.+--+--   If Shake ever has nothing else to do it will run batches before they are at the maximum,+--   so you may see much smaller batches, especially at high parallelism settings.+batch+    :: Int   -- ^ Maximum number to run in a single batch, e.g. @3@, must be positive.+    -> ((a -> Action ()) -> Rules ()) -- ^ Way to match an entry, e.g. @\"*.ext\" '%>'@.+    -> (a -> Action b)  -- ^ Preparation to run individually on each, e.g. using 'need'.+    -> ([b] -> Action ())  -- ^ Combination action to run on all, e.g. using 'cmd'.+    -> Rules ()+batch mx pred one many+    | mx <= 0 = error $ "Can't call batchable with <= 0, you used " ++ show mx+    | mx == 1 = pred $ \a -> do b <- one a; many [b]+    | otherwise = do+        todo :: IORef (Int, [(b, Local, Fence IO (Either SomeException (Seconds, Local)))]) <- liftIO $ newIORef (0, [])+        pred $ \a -> do+            b <- one a+            fence <- liftIO newFence+            -- add one to the batch+            local <- Action getRW+            count <- liftIO $ atomicModifyIORef todo $ \(count, bs) -> let i = count+1 in ((i, (b,local,fence):bs), i)+            requeue todo (==) count+            (wait, (cost, local2)) <- actionFenceRequeue fence+            Action $ modifyRW $ \root -> addDiscount (wait - cost) $ localMergeMutable root [local2]+    where+        -- When changing by one, only trigger on (==) so we don't have lots of waiting pool entries+        -- When changing by many, trigger on (>=) because we don't hit all edges+        requeue todo trigger count+            | count `trigger` mx = addPoolWait_ PoolResume $ go todo+            | count `trigger` 1  = addPoolWait_ PoolBatch  $ go todo+            | otherwise = pure ()++        go todo = do+            -- delete at most mx from the batch+            (now, count) <- liftIO $ atomicModifyIORef todo $ \(count, bs) ->+                let (now,later) = splitAt mx bs+                    count2 = if count > mx then count - mx else 0+                in ((count2, later), (now, count2))+            requeue todo (>=) count++            unless (null now) $ do+                res <- Action $ tryRAW $ do+                    -- make sure we are using one of the local's that we are computing+                    -- we things like stack, blockApply etc. work as expected+                    modifyRW $ const $ localClearMutable $ snd3 $ headErr now+                    start <- liftIO offsetTime+                    fromAction $ many $ map fst3 now+                    end <- liftIO start++                    -- accounting for time is tricky, we spend time T, over N jobs+                    -- so want to charge everyone for T / N time+                    -- but that also means we need to subtract localDiscount so we don't apply that to all+                    rw <- getRW+                    let t = end - localDiscount rw+                    let n = intToDouble (length now)+                    pure (t / n, rw{localDiscount = 0})+                liftIO $ mapM_ (flip signalFence res . thd3) now+++-- | Given a running task, reschedule so it only continues after all other pending tasks,+--   and all rescheduled tasks with a higher pool priority. Note that due to parallelism there is no guarantee+--   that all actions of a higher pool priority will have /completed/ before the action resumes.+--   Only useful if the results are being interactively reported or consumed.+reschedule :: Double -> Action ()+reschedule x = do+    (wait, _) <- actionAlwaysRequeuePriority (PoolDeprioritize $ negate x) $ pure ()+    Action $ modifyRW $ addDiscount wait+++getCurrentKey :: Action (Maybe Key)+getCurrentKey = Action $ topStack . localStack <$> getRW++getLocal :: Action Local+getLocal = Action getRW++-- | Hooked up to --share-remove+actionShareRemove :: [String] -> Action ()+actionShareRemove substrs = do+    Global{..} <- Action getRO+    case globalShared of+        Nothing -> throwM $ errorInternal "actionShareRemove with no shared"+        Just x -> liftIO $ removeShared x $ \k -> any (`isInfixOf` show k) substrs++-- | Hooked up to --share-list+actionShareList :: Action ()+actionShareList = do+    Global{..} <- Action getRO+    case globalShared of+        Nothing -> throwM $ errorInternal "actionShareList with no shared"+        Just x -> liftIO $ listShared x++-- | Hooked up to --share-sanity+actionShareSanity :: Action ()+actionShareSanity = do+    Global{..} <- Action getRO+    case globalShared of+        Nothing -> throwM $ errorInternal "actionShareSanity with no shared"+        Just x -> liftIO $ sanityShared x
+ src/Development/Shake/Internal/Core/Build.hs view
@@ -0,0 +1,346 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RecordWildCards, PatternGuards, ScopedTypeVariables, NamedFieldPuns, GADTs #-}+{-# LANGUAGE Rank2Types, ConstraintKinds, TypeOperators, TupleSections, ViewPatterns #-}++module Development.Shake.Internal.Core.Build(+    getDatabaseValue, getDatabaseValueGeneric,+    historyIsEnabled, historySave, historyLoad,+    applyKeyValue,+    apply, apply1,+    ) where++import Development.Shake.Classes+import General.Pool+import Development.Shake.Internal.Core.Database+import Development.Shake.Internal.Value+import Development.Shake.Internal.Errors+import Development.Shake.Internal.Core.Types+import Development.Shake.Internal.Core.Action+import Development.Shake.Internal.History.Shared+import Development.Shake.Internal.History.Cloud+import Development.Shake.Internal.Options+import Development.Shake.Internal.Core.Monad+import General.Wait+import qualified Data.ByteString.Char8 as BS+import Control.Monad.IO.Class+import General.Extra+import General.Intern(Id)++import Control.Exception+import Control.Monad.Extra+import Numeric.Extra+import qualified Data.HashMap.Strict as Map+import Development.Shake.Internal.Core.Rules+import Data.Typeable+import Data.Maybe+import Data.List.Extra+import Data.Either.Extra+import System.Time.Extra+++---------------------------------------------------------------------+-- LOW-LEVEL OPERATIONS ON THE DATABASE++setIdKeyStatus :: Global -> Database -> Id -> Key -> Status -> Locked ()+setIdKeyStatus Global{..} db i k v = do+    liftIO $ globalDiagnostic $ do+        -- actually safe because we only lose the Locked to enter the diagnostic context+        old <- getKeyValueFromId db i+        let changeStatus = maybe "Missing" (statusType . snd) old ++ " -> " ++ statusType v ++ ", " ++ maybe "<unknown>" (show . fst) old+        let changeValue = case v of+                Ready r -> Just $ "    = " ++ showBracket (result r) ++ " " +++                    if changed r == globalStep then "(changed)"+                    else if built r == globalStep then "(unchanged)"+                    else "(didn't run)"+                _ -> Nothing+        pure $ changeStatus ++ maybe "" ("\n" ++) changeValue+    setMem db i k v+++---------------------------------------------------------------------+-- QUERIES++getDatabaseValue :: (RuleResult key ~ value, ShakeValue key, Typeable value) => key -> Action (Maybe (Result (Either BS.ByteString value)))+getDatabaseValue k =+    fmap (fmap $ fmap $ fmap fromValue) $ getDatabaseValueGeneric $ newKey k++getDatabaseValueGeneric :: Key -> Action (Maybe (Result (Either BS.ByteString Value)))+getDatabaseValueGeneric k = do+    Global{..} <- Action getRO+    Just status <- liftIO $ getValueFromKey globalDatabase k+    pure $ getResult status+++---------------------------------------------------------------------+-- NEW STYLE PRIMITIVES++-- | Lookup the value for a single Id, may need to spawn it+lookupOne :: Global -> Stack -> Database -> Id -> Wait Locked (Either SomeException (Result (Value, BS_Store)))+lookupOne global stack database i = do+    res <- quickly $ liftIO $ getKeyValueFromId database i+    case res of+        Nothing -> Now $ Left $ errorStructured "Shake Id no longer exists" [("Id", Just $ show i)] ""+        Just (k, s) -> case s of+            Ready r -> Now $ Right r+            Failed e _ -> Now $ Left e+            Running{} | Left e <- addStack i k stack -> Now $ Left e+            _ -> Later $ \continue -> do+                Just (_, s) <- liftIO $ getKeyValueFromId database i+                case s of+                    Ready r -> continue $ Right r+                    Failed e _ -> continue $ Left e+                    Running (NoShow w) r -> do+                        let w2 v = w v >> continue v+                        setMem database i k $ Running (NoShow w2) r+                    Loaded r -> buildOne global stack database i k (Just r) `fromLater` continue+                    Missing -> buildOne global stack database i k Nothing `fromLater` continue+++-- | Build a key, must currently be either Loaded or Missing, changes to Waiting+buildOne :: Global -> Stack -> Database -> Id -> Key -> Maybe (Result BS.ByteString) -> Wait Locked (Either SomeException (Result (Value, BS_Store)))+buildOne global@Global{..} stack database i k r = case addStack i k stack of+    Left e -> do+        quickly $ setIdKeyStatus global database i k $ mkError e+        pure $ Left e+    Right stack -> Later $ \continue -> do+        setIdKeyStatus global database i k (Running (NoShow continue) r)+        let go = buildRunMode global stack database r+        fromLater go $ \mode -> liftIO $ addPool PoolStart globalPool $+            runKey global stack k r mode $ \res -> do+                runLocked database $ do+                    let val = fmap runValue res+                    res <- liftIO $ getKeyValueFromId database i+                    w <- case res of+                        Just (_, Running (NoShow w) _) -> pure w+                        -- We used to be able to hit here, but we fixed it by ensuring the thread pool workers are all+                        -- dead _before_ any exception bubbles up+                        _ -> throwM $ errorInternal $ "expected Waiting but got " ++ maybe "nothing" (statusType . snd) res ++ ", key " ++ show k+                    setIdKeyStatus global database i k $ either mkError Ready val+                    w val+                case res of+                    Right RunResult{..} | runChanged /= ChangedNothing -> setDisk database i k $ Loaded runValue{result=runStore}+                    _ -> pure ()+    where+        mkError e = Failed e $ if globalOneShot then Nothing else r+++-- | Compute the value for a given RunMode and a restore function to run+buildRunMode :: Global -> Stack -> Database -> Maybe (Result a) -> Wait Locked RunMode+buildRunMode global stack database me = do+    changed <- case me of+        Nothing -> pure True+        Just me -> buildRunDependenciesChanged global stack database me+    pure $ if changed then RunDependenciesChanged else RunDependenciesSame+++-- | Have the dependencies changed+buildRunDependenciesChanged :: Global -> Stack -> Database -> Result a -> Wait Locked Bool+buildRunDependenciesChanged global stack database me = isJust <$> firstJustM id+    [firstJustWaitUnordered (fmap test . lookupOne global stack database) x | Depends x <- depends me]+    where+        test (Right dep) | changed dep <= built me = Nothing+        test _ = Just ()+++---------------------------------------------------------------------+-- ACTUAL WORKERS++applyKeyValue :: [String] -> [Key] -> Action [Value]+applyKeyValue callStack ks = do+    -- this is the only place a user can inject a key into our world, so check they aren't throwing+    -- in unevaluated bottoms+    liftIO $ mapM_ (evaluate . rnf) ks++    global@Global{..} <- Action getRO+    Local{localStack, localBlockApply} <- Action getRW+    let stack = addCallStack callStack localStack++    let tk = typeKey $ headDef (newKey ()) ks -- always called at non-empty so never see () key+    whenJust localBlockApply $ throwM . errorNoApply tk (show <$> listToMaybe ks)++    let database = globalDatabase+    (is, wait) <- liftIO $ runLocked database $ do+        is <- mapM (mkId database) ks+        wait <- runWait $ do+            x <- firstJustWaitUnordered (fmap (either Just (const Nothing)) . lookupOne global stack database) $ nubOrd is+            case x of+                Just e -> pure $ Left e+                Nothing -> quickly $ Right <$> mapM (fmap (\(Just (_, Ready r)) -> fst $ result r) . liftIO . getKeyValueFromId database) is+        pure (is, wait)+    Action $ modifyRW $ \s -> s{localDepends = addDepends1 (localDepends s) $ Depends is}++    case wait of+        Now vs -> either throwM pure vs+        _ -> do+            offset <- liftIO offsetTime+            vs <- Action $ captureRAW $ \continue ->+                runLocked globalDatabase $ fromLater wait $ \x ->+                    liftIO $ addPool (if isLeft x then PoolException else PoolResume) globalPool $ continue x+            offset <- liftIO offset+            Action $ modifyRW $ addDiscount offset+            pure vs+++runKey+    :: Global+    -> Stack  -- Given the current stack with the key added on+    -> Key -- The key to build+    -> Maybe (Result BS.ByteString) -- A previous result, or Nothing if never been built before+    -> RunMode -- True if any of the children were dirty+    -> Capture (Either SomeException (RunResult (Result (Value, BS_Store))))+        -- Either an error, or a (the produced files, the result).+runKey global@Global{globalOptions=ShakeOptions{..},..} stack k r mode continue = do+    let tk = typeKey k+    BuiltinRule{..} <- case Map.lookup tk globalRules of+        Nothing -> throwM $ errorNoRuleToBuildType tk (Just $ show k) Nothing+        Just r -> pure r++    let s = (newLocal stack shakeVerbosity){localBuiltinVersion = builtinVersion}+    time <- offsetTime+    runAction global s (do+        res <- builtinRun k (fmap result r) mode+        liftIO $ evaluate $ rnf res++        -- completed, now track anything required afterwards+        when (runChanged res `elem` [ChangedRecomputeSame,ChangedRecomputeDiff]) $ do+            -- if the users code didn't run you don't have to check anything (we assume builtin rules are correct)+            globalRuleFinished k+            producesCheck++        Action $ fmap (res,) getRW) $ \case+            Left e ->+                continue . Left . toException =<< shakeException global stack e+            Right (RunResult{..}, Local{..})+                | runChanged == ChangedNothing || runChanged == ChangedStore, Just r <- r ->+                    continue $ Right $ RunResult runChanged runStore (r{result = mkResult runValue runStore})+                | otherwise -> do+                    dur <- time+                    let (cr, c) | Just r <- r, runChanged == ChangedRecomputeSame = (ChangedRecomputeSame, changed r)+                                | otherwise = (ChangedRecomputeDiff, globalStep)+                    continue $ Right $ RunResult cr runStore Result+                        {result = mkResult runValue runStore+                        ,changed = c+                        ,built = globalStep+                        ,depends = flattenDepends localDepends+                        ,execution = doubleToFloat $ dur - localDiscount+                        ,traces = flattenTraces localTraces}+            where+                mkResult value store = (value, if globalOneShot then BS.empty else store)++---------------------------------------------------------------------+-- USER key/value WRAPPERS++-- | Execute a rule, returning the associated values. If possible, the rules will be run in parallel.+--   This function requires that appropriate rules have been added with 'addBuiltinRule'.+--   All @key@ values passed to 'apply' become dependencies of the 'Action'.+apply :: (Partial, RuleResult key ~ value, ShakeValue key, Typeable value) => [key] -> Action [value]+apply [] =+    -- if they do [] then we don't test localBlockApply, but unclear if that should be an error or not+    pure []+apply ks =+    fmap (map fromValue) $ Action $ stepRAW (callStackFull, map newKey ks)+++-- | Apply a single rule, equivalent to calling 'apply' with a singleton list. Where possible,+--   use 'apply' to allow parallelism.+apply1 :: (Partial, RuleResult key ~ value, ShakeValue key, Typeable value) => key -> Action value+apply1 = withFrozenCallStack $ fmap headErr . apply . pure++++---------------------------------------------------------------------+-- HISTORY STUFF++-- | Load a value from the history. Given a version from any user rule+--   (or @0@), return the payload that was stored by 'historySave'.+--+--   If this function returns 'Just' it will also have restored any files that+--   were saved by 'historySave'.+historyLoad :: Int -> Action (Maybe BS.ByteString)+historyLoad (Ver -> ver) = do+    global@Global{..} <- Action getRO+    Local{localStack, localBuiltinVersion} <- Action getRW+    if isNothing globalShared && isNothing globalCloud then pure Nothing else do+        key <- liftIO $ evaluate $ fromMaybe (error "Can't call historyLoad outside a rule") $ topStack localStack+        let database = globalDatabase+        res <- liftIO $ runLocked database $ runWait $ do+            let ask k = do+                    i <- quickly $ mkId database k+                    let identify = runIdentify globalRules k . fst . result+                    either (const Nothing) identify <$> lookupOne global localStack database i+            x <- case globalShared of+                Nothing -> pure Nothing+                Just shared -> lookupShared shared ask key localBuiltinVersion ver+            x <- case x of+                Just res -> pure $ Just res+                Nothing -> case globalCloud of+                    Nothing -> pure Nothing+                    Just cloud -> lookupCloud cloud ask key localBuiltinVersion ver+            case x of+                Nothing -> pure Nothing+                Just (a,b,c) -> quickly $ Just . (a,,c) <$> mapM (mapM $ mkId database) b+        -- FIXME: If running with cloud and shared, and you got a hit in cloud, should also add it to shared+        res <- case res of+            Now x -> pure x+            _ -> do+                offset <- liftIO offsetTime+                res <- Action $ captureRAW $ \continue ->+                    runLocked globalDatabase $ fromLater res $ \x ->+                        liftIO $ addPool PoolResume globalPool $ continue $ Right x+                offset <- liftIO offset+                Action $ modifyRW $ addDiscount offset+                pure res+        case res of+            Nothing -> pure Nothing+            Just (res, deps, restore) -> do+                liftIO $ globalDiagnostic $ pure $ "History hit for " ++ show key+                liftIO restore+                Action $ modifyRW $ \s -> s{localDepends = newDepends $ map Depends deps}+                pure (Just res)+++-- | Is the history enabled, returns 'True' if you have a 'shakeShare' or 'shakeCloud',+--   and haven't called 'historyDisable' so far in this rule.+historyIsEnabled :: Action Bool+historyIsEnabled = Action $ do+    Global{..} <- getRO+    Local{localHistory} <- getRW+    pure $ localHistory && (isJust globalShared || isJust globalCloud)+++-- | Save a value to the history. Record the version of any user rule+--   (or @0@), and a payload. Must be run at the end of the rule, after+--   any dependencies have been captured. If history is enabled, stores the information+--   in a cache.+--+--   This function relies on 'produces' to have been called correctly to describe+--   which files were written during the execution of this rule.+historySave :: Int -> BS.ByteString -> Action ()+historySave (Ver -> ver) store = whenM historyIsEnabled $ Action $ do+    Global{..} <- getRO+    Local{localProduces, localDepends, localBuiltinVersion, localStack} <- getRW+    liftIO $ do+        -- make sure we throw errors before we get into the history+        evaluate ver+        evaluate store+        key <- evaluate $ fromMaybe (error "Can't call historySave outside a rule") $ topStack localStack++        let produced = reverse $ map snd localProduces+        deps <-+            -- can do this without the DB lock, since it reads things that are stable+            forNothingM (flattenDepends localDepends) $ \(Depends is) -> forNothingM is $ \i -> do+                Just (k, Ready r) <- getKeyValueFromId globalDatabase i+                pure $ (k,) <$> runIdentify globalRules k (fst $ result r)+        let k = topStack localStack+        case deps of+            Nothing -> liftIO $ globalDiagnostic $ pure $ "Dependency with no identity for " ++ show k+            Just deps -> do+                whenJust globalShared $ \shared -> addShared shared key localBuiltinVersion ver deps store produced+                whenJust globalCloud  $ \cloud  -> addCloud  cloud  key localBuiltinVersion ver deps store produced+                liftIO $ globalDiagnostic $ pure $ "History saved for " ++ show k+++runIdentify :: Map.HashMap TypeRep BuiltinRule -> Key -> Value -> Maybe BS.ByteString+runIdentify mp k v+    | Just BuiltinRule{..} <- Map.lookup (typeKey k) mp = builtinIdentity k v+    | otherwise = throwImpure $ errorInternal "runIdentify can't find rule"
+ src/Development/Shake/Internal/Core/Database.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE GeneralizedNewtypeDeriving, RecordWildCards #-}++module Development.Shake.Internal.Core.Database(+    Locked, runLocked,+    DatabasePoly, createDatabase,+    mkId,+    getValueFromKey, getIdFromKey, getKeyValues, getKeyValueFromId, getKeyValuesFromId,+    setMem, setDisk, modifyAllMem+    ) where++import Data.Tuple.Extra+import Data.IORef.Extra+import General.Intern(Id, Intern)+import Development.Shake.Classes+import qualified Data.HashMap.Strict as Map+import qualified General.Intern as Intern+import Control.Concurrent.Extra+import Control.Monad.IO.Class+import qualified General.Ids as Ids+import Control.Monad.Fail+import Prelude+++newtype Locked a = Locked (IO a)+    deriving (Functor, Applicative, Monad, MonadIO, MonadFail)++runLocked :: DatabasePoly k v -> Locked b -> IO b+runLocked db (Locked act) = withLock (lock db) act+++-- | Invariant: The database does not have any cycles where a Key depends on itself.+--   Everything is mutable. intern and status must form a bijection.+--   There may be dangling Id's as a result of version changes.+--   Lock is used to prevent any torn updates+data DatabasePoly k v = Database+    {lock :: Lock+    ,intern :: IORef (Intern k) -- ^ Key |-> Id mapping+    ,status :: Ids.Ids (k, v) -- ^ Id |-> (Key, Status) mapping+    ,journal :: Id -> k -> v -> IO () -- ^ Record all changes to status+    ,vDefault :: v+    }+++createDatabase+    :: (Eq k, Hashable k)+    => Ids.Ids (k, v)+    -> (Id -> k -> v -> IO ())+    -> v+    -> IO (DatabasePoly k v)+createDatabase status journal vDefault = do+    xs <- Ids.toList status+    intern <- newIORef $ Intern.fromList [(k, i) | (i, (k,_)) <- xs]+    lock <- newLock+    pure Database{..}+++---------------------------------------------------------------------+-- SAFE READ-ONLY++getValueFromKey :: (Eq k, Hashable k) => DatabasePoly k v -> k -> IO (Maybe v)+getValueFromKey Database{..} k = do+    is <- readIORef intern+    case Intern.lookup k is of+        Nothing -> pure Nothing+        Just i -> fmap snd <$> Ids.lookup status i++-- Returns Nothing only if the Id was serialised previously but then the Id disappeared+getKeyValueFromId :: DatabasePoly k v -> Id -> IO (Maybe (k, v))+getKeyValueFromId Database{..} = Ids.lookup status++getKeyValues :: DatabasePoly k v -> IO [(k, v)]+getKeyValues Database{..} = Ids.elems status++getKeyValuesFromId :: DatabasePoly k v -> IO (Map.HashMap Id (k, v))+getKeyValuesFromId Database{..} = Ids.toMap status++getIdFromKey :: (Eq k, Hashable k) => DatabasePoly k v -> IO (k -> Maybe Id)+getIdFromKey Database{..} = do+    is <- readIORef intern+    pure $ flip Intern.lookup is+++---------------------------------------------------------------------+-- MUTATING++-- | Ensure that a Key has a given Id, creating an Id if there is not one already+mkId :: (Eq k, Hashable k) => DatabasePoly k v -> k -> Locked Id+mkId Database{..} k = liftIO $ do+    is <- readIORef intern+    case Intern.lookup k is of+        Just i -> pure i+        Nothing -> do+            (is, i)<- pure $ Intern.add k is+            -- make sure to write it into Status first to maintain Database invariants+            Ids.insert status i (k, vDefault)+            writeIORef' intern is+            pure i+++setMem :: DatabasePoly k v -> Id -> k -> v -> Locked ()+setMem Database{..} i k v = liftIO $ Ids.insert status i (k,v)++modifyAllMem :: DatabasePoly k v -> (v -> v) -> Locked ()+modifyAllMem Database{..} f = liftIO $ Ids.forMutate status $ \(k,v) ->+    let !v' = f v+    in (k, v')++setDisk :: DatabasePoly k v -> Id -> k -> v -> IO ()+setDisk = journal
+ src/Development/Shake/Internal/Core/Monad.hs view
@@ -0,0 +1,236 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE GADTs, ScopedTypeVariables, TupleSections, GeneralizedNewtypeDeriving #-}++module Development.Shake.Internal.Core.Monad(+    RAW, Capture, runRAW,+    getRO, getRW, putRW, modifyRW,+    stepRAW,+    catchRAW, tryRAW, throwRAW, finallyRAW,+    captureRAW,+    ) where++import Control.Exception.Extra+import Development.Shake.Internal.Errors+import Control.Monad.IO.Class+import Data.IORef+import Control.Monad+import System.IO+import Data.Semigroup+import Control.Monad.Fail+import Prelude+++data RAW k v ro rw a where+    Fmap :: (a -> b) -> RAW k v ro rw a -> RAW k v ro rw b+    Pure :: a -> RAW k v ro rw a+    Ap :: RAW k v ro rw (a -> b) -> RAW k v ro rw a -> RAW k v ro rw b+    Next :: RAW k v ro rw a -> RAW k v ro rw b -> RAW k v ro rw b+    Bind :: RAW k v ro rw a -> (a -> RAW k v ro rw b) -> RAW k v ro rw b+    LiftIO :: IO a -> RAW k v ro rw a+    GetRO :: RAW k v ro rw ro+    GetRW :: RAW k v ro rw rw+    PutRW :: !rw -> RAW k v ro rw ()+    ModifyRW :: (rw -> rw) -> RAW k v ro rw ()+    StepRAW :: k -> RAW k v ro rw v+    CaptureRAW :: Capture (Either SomeException a) -> RAW k v ro rw a+    CatchRAW :: RAW k v ro rw a -> (SomeException -> RAW k v ro rw a) -> RAW k v ro rw a++instance Functor (RAW k v ro rw) where+    fmap = Fmap++instance Applicative (RAW k v ro rw) where+    pure = Pure+    (*>) = Next+    (<*>) = Ap++instance Monad (RAW k v ro rw) where+    return = pure+    (>>) = (*>)+    (>>=) = Bind++instance MonadIO (RAW k v ro rw) where+    liftIO = LiftIO++instance MonadFail (RAW k v ro rw) where+    fail = liftIO . Control.Monad.Fail.fail++instance Semigroup a => Semigroup (RAW k v ro rw a) where+    (<>) a b = (<>) <$> a <*> b++instance (Semigroup a, Monoid a) => Monoid (RAW k v ro rw a) where+    mempty = pure mempty+    mappend = (<>)+++type Capture a = (a -> IO ()) -> IO ()+++-- Useful for checking that all continuations are run only once+-- Cannot be enabled for performance reasons and because some of+-- "monad test" deliberately breaks the invariant to check it doesn't go wrong+assertOnceCheck = False++assertOnce :: MonadIO m => String -> (a -> m b) -> IO (a -> m b)+assertOnce msg k+    | not assertOnceCheck = pure k+    | otherwise = do+        ref <- liftIO $ newIORef False+        pure $ \v -> do+            liftIO $ join $ atomicModifyIORef ref $ \old -> (True,) $ when old $ do+                hPutStrLn stderr "FATAL ERROR: assertOnce failed"+                Prelude.fail $ "assertOnce failed: " ++ msg+            k v++-- | Run and then call a continuation.+runRAW :: ([k] -> RAW k v ro rw [v]) -> ro -> rw -> RAW k v ro rw a -> Capture (Either SomeException a)+runRAW step ro rw m k = do+    k <- assertOnce "runRAW" k+    rw <- newIORef rw+    handler <- newIORef throwIO+    steps <- newSteps+    writeIORef handler $ \e -> do+        -- make sure we never call the error continuation twice+        writeIORef handler throwIO+        k $ Left e+    -- If the continuation itself throws an error we need to make sure we+    -- don't end up running it twice (once with its result, once with its own exception)+    goRAW step steps handler ro rw m (\v -> do writeIORef handler throwIO; k $ Right v)+        `catch_` \e -> ($ e) =<< readIORef handler+++goRAW :: forall k v ro rw a . ([k] -> RAW k v ro rw [v]) -> Steps k v -> IORef (SomeException -> IO ()) -> ro -> IORef rw -> RAW k v ro rw a -> Capture a+goRAW step steps handler ro rw = \x k -> go x $ \v -> sio v k+    where+        sio :: SIO b -> Capture b+        sio (SIO v) k = flush $ do v <- v; k v++        flush :: IO () -> IO ()+        flush k = do+            v <- flushSteps steps+            case v of+                Nothing -> k+                Just f -> go (f step) $ const k++        unflush :: IO ()+        unflush = unflushSteps steps++        go :: RAW k v ro rw b -> Capture (SIO b)+        go x k = case x of+            Fmap f a -> go a $ \v -> k $ fmap f v+            Pure a -> k $ pure a+            Ap f x -> go f $ \f -> go x $ \v -> k $ f <*> v+            Next a b -> go a $ \a -> go b $ \b -> k $ a *> b+            StepRAW q -> do+                v <- addStep steps q+                k v++            Bind a b -> go a $ \a -> sio a $ \a -> go (b a) k+            LiftIO act -> flush $ do v <- act; k $ pure v++            GetRO -> k $ pure ro+            GetRW -> flush $ k . pure =<< readIORef rw+            PutRW x -> flush $ writeIORef rw x >> k (pure ())+            ModifyRW f -> flush $ modifyIORef' rw f >> k (pure ())++            CatchRAW m hdl -> flush $ do+                hdl <- assertOnce "CatchRAW" hdl+                old <- readIORef handler+                writeIORef handler $ \e -> do+                    writeIORef handler old+                    go (hdl e) k `catch_`+                        \e -> do unflush; ($ e) =<< readIORef handler+                go m $ \x -> writeIORef handler old >> k x++            CaptureRAW f -> flush $ do+                f <- assertOnce "CaptureRAW" f+                old <- readIORef handler+                writeIORef handler throwIO+                f $ \case+                    Left e -> old e+                    Right v -> do+                        writeIORef handler old+                        k (pure v) `catch_` \e -> do unflush; ($ e) =<< readIORef handler+++newtype SIO a = SIO (IO a)+    deriving (Functor, Monad, Applicative)+++newtype Steps k v = Steps (IORef [(k, IORef v)])++newSteps :: IO (Steps k v)+newSteps = Steps <$> newIORef []++addStep :: Steps k v -> k -> IO (SIO v)+addStep (Steps ref) k = do+    out <- newIORef $ throwImpure $ errorInternal "Monad, addStep not flushed"+    modifyIORef ref ((k,out):)+    pure $ SIO $ readIORef out++unflushSteps :: Steps k v -> IO ()+unflushSteps (Steps ref) = writeIORef ref []++flushSteps :: MonadIO m => Steps k v -> IO (Maybe (([k] -> m [v]) -> m ()))+flushSteps (Steps ref) = do+    v <- reverse <$> readIORef ref+    case v of+        [] -> pure Nothing+        xs -> do+            writeIORef ref []+            pure $ Just $ \step -> do+                vs <- step $ map fst xs+                liftIO $ zipWithM_ writeIORef (map snd xs) vs+++---------------------------------------------------------------------+-- STANDARD++getRO :: RAW k v ro rw ro+getRO = GetRO++getRW :: RAW k v ro rw rw+getRW = GetRW++-- | Strict version+putRW :: rw -> RAW k v ro rw ()+putRW = PutRW++modifyRW :: (rw -> rw) -> RAW k v ro rw ()+modifyRW = ModifyRW+++---------------------------------------------------------------------+-- EXCEPTIONS++catchRAW :: RAW k v ro rw a -> (SomeException -> RAW k v ro rw a) -> RAW k v ro rw a+catchRAW = CatchRAW++tryRAW :: RAW k v ro rw a -> RAW k v ro rw (Either SomeException a)+tryRAW m = catchRAW (fmap Right m) (pure . Left)++throwRAW :: Exception e => e -> RAW k v ro rw a+-- Note that while we could directly pass this to the handler+-- that would avoid triggering the catch, which would mean they built up on the stack+throwRAW = liftIO . throwIO++finallyRAW :: RAW k v ro rw a -> RAW k v ro rw b -> RAW k v ro rw a+finallyRAW a undo = do+    r <- catchRAW a (\e -> undo >> throwRAW e)+    undo+    pure r+++---------------------------------------------------------------------+-- CONTINUATIONS++-- | Capture a continuation. The continuation should be called at most once.+--   Calling the same continuation, multiple times, in parallel, results in incorrect behaviour.+captureRAW :: Capture (Either SomeException a) -> RAW k v ro rw a+captureRAW = CaptureRAW+++---------------------------------------------------------------------+-- STEPS++stepRAW :: k -> RAW k v ro rw v+stepRAW = StepRAW
+ src/Development/Shake/Internal/Core/Pool.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE RecordWildCards, TupleSections #-}++module Development.Shake.Internal.Core.Pool(+    addPoolWait, actionFenceSteal, actionFenceRequeue,+    actionAlwaysRequeue, actionAlwaysRequeuePriority,+    addPoolWait_,+    actionFenceRequeueBy+    ) where++import Control.Exception+import General.Pool+import Development.Shake.Internal.Core.Types+import Development.Shake.Internal.Core.Monad+import System.Time.Extra+import Data.Either.Extra+import Control.Monad.IO.Class+import General.Fence+++priority x = if isLeft x then PoolException else PoolResume+++-- | Enqueue an Action into the pool and return a Fence to wait for it.+--   Returns the value along with how long it spent executing.+addPoolWait :: PoolPriority -> Action a -> Action (Fence IO (Either SomeException (Seconds, a)))+addPoolWait pri act = do+    ro@Global{..} <- Action getRO+    rw <- Action getRW+    liftIO $ do+        fence <- newFence+        let act2 = do offset <- liftIO offsetTime; res <- act; offset <- liftIO offset; pure (offset, res)+        addPool pri globalPool $ runAction ro rw act2 $ signalFence fence+        pure fence++-- | Like 'addPoolWait' but doesn't provide a fence to wait for it - a fire and forget version.+--   Warning: If Action throws an exception, it would be lost, so must be executed with try. Seconds are not tracked.+addPoolWait_ :: PoolPriority -> Action a -> Action ()+addPoolWait_ pri act = do+    ro@Global{..} <- Action getRO+    rw <- Action getRW+    liftIO $ addPool pri globalPool $ runAction ro rw act $ \_ -> pure ()+++actionFenceSteal :: Fence IO (Either SomeException a) -> Action (Seconds, a)+actionFenceSteal fence = do+    res <- liftIO $ testFence fence+    case res of+        Just (Left e) -> Action $ throwRAW e+        Just (Right v) -> pure (0, v)+        Nothing -> Action $ captureRAW $ \continue -> do+            offset <- offsetTime+            waitFence fence $ \v -> do+                offset <- offset+                continue $ (offset,) <$> v+++actionFenceRequeue :: Fence IO (Either SomeException b) -> Action (Seconds, b)+actionFenceRequeue = actionFenceRequeueBy id++actionFenceRequeueBy :: (a -> Either SomeException b) -> Fence IO a -> Action (Seconds, b)+actionFenceRequeueBy op fence = Action $ do+    res <- liftIO $ testFence fence+    case fmap op res of+        Just (Left e) -> throwRAW e+        Just (Right v) -> pure (0, v)+        Nothing -> do+            Global{..} <- getRO+            offset <- liftIO offsetTime+            captureRAW $ \continue -> waitFence fence $ \v -> do+                let v2 = op v+                addPool (priority v2) globalPool $ do+                    offset <- offset+                    continue $ (offset,) <$> v2+++actionAlwaysRequeue :: Either SomeException a -> Action (Seconds, a)+actionAlwaysRequeue res = actionAlwaysRequeuePriority (priority res) res++actionAlwaysRequeuePriority :: PoolPriority -> Either SomeException a -> Action (Seconds, a)+actionAlwaysRequeuePriority pri res = Action $ do+    Global{..} <- getRO+    offset <- liftIO offsetTime+    captureRAW $ \continue ->+        addPool pri globalPool $ do+            offset <- offset+            continue $ (offset,) <$> res
+ src/Development/Shake/Internal/Core/Rules.hs view
@@ -0,0 +1,345 @@+{-# LANGUAGE RecordWildCards, ScopedTypeVariables #-}+{-# LANGUAGE GeneralizedNewtypeDeriving, ConstraintKinds, NamedFieldPuns #-}+{-# LANGUAGE ExistentialQuantification, RankNTypes #-}+{-# LANGUAGE TypeFamilies, TypeOperators, DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}++module Development.Shake.Internal.Core.Rules(+    Rules, SRules(..), runRules,+    RuleResult, addBuiltinRule, addBuiltinRuleEx,+    noLint, noIdentity,+    getShakeOptionsRules,+    getUserRuleInternal, getUserRuleOne, getUserRuleList, getUserRuleMaybe,+    addUserRule, alternatives, priority, versioned,+    getTargets, addTarget, withTargetDocs, withoutTargets,+    addHelpSuffix, getHelpSuffix,+    action, withoutActions+    ) where++import Control.Applicative+import Data.Tuple.Extra+import Control.Exception+import Control.Monad.Extra+import Control.Monad.Fix+import Control.Monad.IO.Class+import Control.Monad.Trans.Reader+import Development.Shake.Classes+import General.Binary+import General.Extra+import Data.Typeable+import Data.Data+import Data.List.Extra+import qualified Data.HashMap.Strict as Map+import qualified General.TypeMap as TMap+import Data.Maybe+import Data.IORef+import Data.Semigroup+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Binary.Builder as Bin+import Data.Binary.Put+import Data.Binary.Get+import General.ListBuilder+import Control.Monad.Fail+import Prelude++import Development.Shake.Internal.Core.Types+import Development.Shake.Internal.Core.Monad+import Development.Shake.Internal.Value+import Development.Shake.Internal.Options+import Development.Shake.Internal.Errors+++---------------------------------------------------------------------+-- RULES++-- | Get the 'ShakeOptions' that were used.+getShakeOptionsRules :: Rules ShakeOptions+getShakeOptionsRules = Rules $ asks fst+++-- | Internal variant, more flexible, but not such a nice API+--   Same args as getuserRuleMaybe, but returns (guaranteed version, items, error to throw if wrong number)+--   Fields are returned lazily, in particular ver can be looked up cheaper+getUserRuleInternal :: forall key a b . (ShakeValue key, Typeable a) => key -> (a -> Maybe String) -> (a -> Maybe b) -> Action (Maybe Ver, [(Int, b)], SomeException)+getUserRuleInternal key disp test = do+    Global{..} <- Action getRO+    let UserRuleVersioned versioned rules = fromMaybe mempty $ TMap.lookup globalUserRules+    let ver = if versioned then Nothing else Just $ Ver 0+    let items = headDef [] $ map snd $ reverse $ groupSort $ f (Ver 0) Nothing rules+    let err = errorMultipleRulesMatch (typeOf key) (show key) (map snd3 items)+    pure (ver, map (\(Ver v,_,x) -> (v,x)) items, err)+    where+        f :: Ver -> Maybe Double -> UserRule a -> [(Double,(Ver,Maybe String,b))]+        f v p (UserRule x) = [(fromMaybe 1 p, (v,disp x,x2)) | Just x2 <- [test x]]+        f v p (Unordered xs) = concatMap (f v p) xs+        f v p (Priority p2 x) = f v (Just $ fromMaybe p2 p) x+        f _ p (Versioned v x) = f v p x+        f v p (Alternative x) = take 1 $ f v p x+++-- | Get the user rules that were added at a particular type which return 'Just' on a given function.+--   Return all equally applicable rules, paired with the version of the rule+--   (set by 'versioned'). Where rules are specified with 'alternatives' or 'priority'+--   the less-applicable rules will not be returned.+--+--   If you can only deal with zero/one results, call 'getUserRuleMaybe' or 'getUserRuleOne',+--   which raise informative errors.+getUserRuleList :: Typeable a => (a -> Maybe b) -> Action [(Int, b)]+getUserRuleList test = snd3 <$> getUserRuleInternal () (const Nothing) test+++-- | A version of 'getUserRuleList' that fails if there is more than one result+--   Requires a @key@ for better error messages.+getUserRuleMaybe :: (ShakeValue key, Typeable a) => key -> (a -> Maybe String) -> (a -> Maybe b) -> Action (Maybe (Int, b))+getUserRuleMaybe key disp test = do+    (_, xs, err) <- getUserRuleInternal key disp test+    case xs of+        [] -> pure Nothing+        [x] -> pure $ Just x+        _ -> throwM err++-- | A version of 'getUserRuleList' that fails if there is not exactly one result+--   Requires a @key@ for better error messages.+getUserRuleOne :: (ShakeValue key, Typeable a) => key -> (a -> Maybe String) -> (a -> Maybe b) -> Action (Int, b)+getUserRuleOne key disp test = do+    (_, xs, err) <- getUserRuleInternal key disp test+    case xs of+        [x] -> pure x+        _ -> throwM err+++-- | Define a set of rules. Rules can be created with calls to functions such as 'Development.Shake.%>' or 'action'.+--   Rules are combined with either the 'Monoid' instance, or (more commonly) the 'Monad' instance and @do@ notation.+--   To define your own custom types of rule, see "Development.Shake.Rule".+newtype Rules a = Rules (ReaderT (ShakeOptions, IORef (SRules ListBuilder)) IO a) -- All IO must be associative/commutative (e.g. creating IORef/MVars)+    deriving (Functor, Applicative, Monad, MonadIO, MonadFix, Control.Monad.Fail.MonadFail)++newRules :: SRules ListBuilder -> Rules ()+newRules x = Rules $ liftIO . flip modifyIORef' (<> x) =<< asks snd++modifyRulesScoped :: (SRules ListBuilder -> SRules ListBuilder) -> Rules a -> Rules a+modifyRulesScoped f (Rules r) = Rules $ do+    (opts, refOld) <- ask+    liftIO $ do+        refNew <- newIORef mempty+        res <- runReaderT r (opts, refNew)+        rules <- readIORef refNew+        modifyIORef' refOld (<> f rules)+        pure res++runRules :: ShakeOptions -> Rules () -> IO (SRules [])+runRules opts (Rules r) = do+    ref <- newIORef mempty{allowOverwrite = shakeAllowRedefineRules opts}+    runReaderT r (opts, ref)+    SRules{..} <- readIORef ref+    pure $ SRules (runListBuilder actions) builtinRules userRules (runListBuilder targets) (runListBuilder helpSuffix) allowOverwrite++-- | Get all targets registered in the given rules. The names in+--   'Development.Shake.phony' and 'Development.Shake.~>' as well as the file patterns+--   in 'Development.Shake.%>', 'Development.Shake.|%>' and 'Development.Shake.&%>' are+--   registered as targets, plus any explicit calls to 'addTarget'.+--   Returns the command, paired with the documentation (if any).+getTargets :: ShakeOptions -> Rules () -> IO [(String, Maybe String)]+getTargets opts rs = do+    SRules{targets} <- runRules opts rs+    pure [(target, documentation) | Target{..} <- targets]++getHelpSuffix :: ShakeOptions -> Rules () -> IO [String]+getHelpSuffix opts rs = do+    SRules{helpSuffix} <- runRules opts rs+    pure helpSuffix++data Target = Target+    {target :: !String+    ,documentation :: !(Maybe String)+    } deriving (Eq,Ord,Show,Read,Data,Typeable)++data SRules list = SRules+    {actions :: !(list (Stack, Action ()))+    ,builtinRules :: !(Map.HashMap TypeRep{-k-} BuiltinRule)+    ,userRules :: !(TMap.Map UserRuleVersioned)+    ,targets :: !(list Target)+    ,helpSuffix :: !(list String)+    ,allowOverwrite :: Bool+    }++instance Semigroup (SRules ListBuilder) where+    (SRules x1 x2 x3 x4 x5 x6) <> (SRules y1 y2 y3 y4 y5 y6) =+      SRules (mappend x1 y1) (Map.unionWithKey f x2 y2) (TMap.unionWith (<>) x3 y3) (mappend x4 y4) (mappend x5 y5) canOverwrite+      where+        canOverwrite = x6 && y6+        f k a b+          | canOverwrite = b+          | otherwise = throwImpure $ errorRuleDefinedMultipleTimes k [builtinLocation a, builtinLocation b]++instance Monoid (SRules ListBuilder) where+    mempty = SRules mempty Map.empty TMap.empty mempty mempty True+    mappend = (<>)++instance Semigroup a => Semigroup (Rules a) where+    (<>) = liftA2 (<>)++instance (Semigroup a, Monoid a) => Monoid (Rules a) where+    mempty = pure mempty+    mappend = (<>)+++-- | Add a user rule. In general these should be specialised to the type expected by a builtin rule.+--   The user rules can be retrieved by 'getUserRuleList'.+addUserRule :: Typeable a => a -> Rules ()+addUserRule r = newRules mempty{userRules = TMap.singleton $ UserRuleVersioned False $ UserRule r}++-- | Register a target, as available when passing @--help@ or through 'getTargets'.+--   Called automatically by rules such as 'Development.Shake.phony' and+--   'Development.Shake.%>' - to avoid that use 'withoutTargets'.+--   To add documentation to a target use 'withTargetDocs'.+addTarget :: String -> Rules ()+addTarget t = newRules mempty{targets = newListBuilder $ Target t Nothing}++-- | For all 'addTarget' targets within the 'Rules' provide the specified documentation, if they+--   don't already have documentation.+withTargetDocs :: String -> Rules () -> Rules ()+withTargetDocs d = modifyRulesScoped $ \x -> x{targets = f <$> targets x}+    where f (Target a b) = Target a $ Just $ fromMaybe d b++-- | Remove all targets specified in a set of rules, typically because they are internal details.+--   Overrides 'addTarget'.+withoutTargets :: Rules a -> Rules a+withoutTargets = modifyRulesScoped $ \x -> x{targets=mempty}++-- | Adds some extra information at the end of @--help@.+addHelpSuffix :: String -> Rules ()+addHelpSuffix s = newRules mempty{helpSuffix = newListBuilder s}++-- | A suitable 'BuiltinLint' that always succeeds.+noLint :: BuiltinLint key value+noLint _ _ = pure Nothing++-- | A suitable 'BuiltinIdentity' that always fails with a runtime error, incompatible with 'shakeShare'.+--   Use this function if you don't care about 'shakeShare', or if your rule provides a dependency that can+--   never be cached (in which case you should also call 'Development.Shake.historyDisable').+noIdentity :: BuiltinIdentity key value+noIdentity _ _ = Nothing+++-- | The type mapping between the @key@ or a rule and the resulting @value@.+--   See 'addBuiltinRule' and 'Development.Shake.Rule.apply'.+type family RuleResult key -- = value++-- | Before looking at this function, you should read the warnings at the top of this module.+--   This function is not often necessary in build systems.+--+--   Define a builtin rule, passing the functions to run in the right circumstances.+--   The @key@ and @value@ types will be what is used by 'Development.Shake.Rule.apply'.+--   As a start, you can use 'noLint' and 'noIdentity' as the first two functions,+--   but are required to supply a suitable 'BuiltinRun'.+--+--   Raises an error if any other rule exists at this type.+--+--   For a worked example of writing a rule see <https://tech-blog.capital-match.com/posts/5-upgrading-shake.html>.+addBuiltinRule+    :: (RuleResult key ~ value, ShakeValue key, Typeable value, NFData value, Show value, Partial)+    => BuiltinLint key value -> BuiltinIdentity key value -> BuiltinRun key value -> Rules ()+addBuiltinRule = withFrozenCallStack $ addBuiltinRuleInternal $ BinaryOp+    (putEx . Bin.toLazyByteString . execPut . put)+    (runGet get . LBS.fromChunks . pure)++addBuiltinRuleEx+    :: (RuleResult key ~ value, ShakeValue key, BinaryEx key, Typeable value, NFData value, Show value, Partial)+    => BuiltinLint key value -> BuiltinIdentity key value -> BuiltinRun key value -> Rules ()+addBuiltinRuleEx = addBuiltinRuleInternal $ BinaryOp putEx getEx+++-- | Unexpected version of 'addBuiltinRule', which also lets me set the 'BinaryOp'.+addBuiltinRuleInternal+    :: (RuleResult key ~ value, ShakeValue key, Typeable value, NFData value, Show value, Partial)+    => BinaryOp key -> BuiltinLint key value -> BuiltinIdentity key value -> BuiltinRun key value -> Rules ()+addBuiltinRuleInternal binary lint check (run :: BuiltinRun key value) = do+    let k = Proxy :: Proxy key+    let lint_ k v = lint (fromKey k) (fromValue v)+    let check_ k v = check (fromKey k) (fromValue v)+    let run_ k v b = fmap newValue <$> run (fromKey k) v b+    let binary_ = BinaryOp (putOp binary . fromKey) (newKey . getOp binary)+    newRules mempty{builtinRules = Map.singleton (typeRep k) $ BuiltinRule lint_ check_ run_ binary_ (Ver 0) callStackTop}+++-- | Change the priority of a given set of rules, where higher values take precedence.+--   All matching rules at a given priority must be disjoint, or an error is raised.+--   All builtin Shake rules have priority between 0 and 1.+--   Excessive use of 'priority' is discouraged. As an example:+--+-- @+-- 'priority' 4 $ \"hello.*\" %> \\out -> 'writeFile'' out \"hello.*\"+-- 'priority' 8 $ \"*.txt\" %> \\out -> 'writeFile'' out \"*.txt\"+-- @+--+--   In this example @hello.txt@ will match the second rule, instead of raising an error about ambiguity.+--+--   The 'priority' function obeys the invariants:+--+-- @+-- 'priority' p1 ('priority' p2 r1) === 'priority' p1 r1+-- 'priority' p1 (r1 >> r2) === 'priority' p1 r1 >> 'priority' p1 r2+-- @+priority :: Double -> Rules a -> Rules a+priority d = modifyRulesScoped $ \s -> s{userRules = TMap.map (\(UserRuleVersioned b x) -> UserRuleVersioned b $ Priority d x) $ userRules s}+++-- | Indicate that the nested rules have a given version. If you change the semantics of the rule then updating (or adding)+--   a version will cause the rule to rebuild in some circumstances.+--+-- @+-- 'versioned' 1 $ \"hello.*\" %> \\out ->+--     'writeFile'' out \"Writes v1 now\" -- previously wrote out v0+-- @+--+--   You should only use 'versioned' to track changes in the build source, for standard runtime dependencies you should use+--   other mechanisms, e.g. 'Development.Shake.addOracle'.+versioned :: Int -> Rules a -> Rules a+versioned v = modifyRulesScoped $ \s -> s+    {userRules = TMap.map (\(UserRuleVersioned b x) -> UserRuleVersioned (b || v /= 0) $ Versioned (Ver v) x) $ userRules s+    ,builtinRules = Map.map (\b -> b{builtinVersion = Ver v}) $ builtinRules s+    }+++-- | Change the matching behaviour of rules so rules do not have to be disjoint, but are instead matched+--   in order. Only recommended for small blocks containing a handful of rules.+--+-- @+-- 'alternatives' $ do+--     \"hello.*\" %> \\out -> 'writeFile'' out \"hello.*\"+--     \"*.txt\" %> \\out -> 'writeFile'' out \"*.txt\"+-- @+--+--   In this example @hello.txt@ will match the first rule, instead of raising an error about ambiguity.+--   Inside 'alternatives' the 'priority' of each rule is not used to determine which rule matches,+--   but the resulting match uses that priority compared to the rules outside the 'alternatives' block.+alternatives :: Rules a -> Rules a+alternatives = modifyRulesScoped $ \r -> r{userRules = TMap.map (\(UserRuleVersioned b x) -> UserRuleVersioned b $ Alternative x) $ userRules r}+++-- | Run an action, usually used for specifying top-level requirements.+--+-- @+-- main = 'Development.Shake.shake' 'shakeOptions' $ do+--    'action' $ do+--        b <- 'Development.Shake.doesFileExist' \"file.src\"+--        when b $ 'Development.Shake.need' [\"file.out\"]+-- @+--+--   This 'action' builds @file.out@, but only if @file.src@ exists. The 'action'+--   will be run in every build execution (unless 'withoutActions' is used), so only cheap+--   operations should be performed. On the flip side, consulting system information+--   (e.g. environment variables) can be done directly as the information will not be cached.+--   All calls to 'action' may be run in parallel, in any order.+--+--   For the standard requirement of only 'Development.Shake.need'ing a fixed list of files in the 'action',+--   see 'Development.Shake.want'.+action :: Partial => Action a -> Rules ()+action act = newRules mempty{actions=newListBuilder (addCallStack callStackFull emptyStack, void act)}+++-- | Remove all actions specified in a set of rules, usually used for implementing+--   command line specification of what to build.+withoutActions :: Rules a -> Rules a+withoutActions = modifyRulesScoped $ \x -> x{actions=mempty}
+ src/Development/Shake/Internal/Core/Run.hs view
@@ -0,0 +1,394 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RecordWildCards, ScopedTypeVariables, PatternGuards #-}+{-# LANGUAGE ConstraintKinds, TupleSections, ViewPatterns #-}+{-# LANGUAGE TypeFamilies, NamedFieldPuns #-}++module Development.Shake.Internal.Core.Run(+    RunState,+    open,+    reset,+    run,+    shakeRunAfter,+    liveFilesState,+    profileState,+    errorsState+    ) where++import Control.Exception+import Data.Tuple.Extra+import Control.Concurrent.Extra hiding (withNumCapabilities)+import Development.Shake.Internal.Core.Database+import Control.Monad.IO.Class+import General.Binary+import Development.Shake.Classes+import Development.Shake.Internal.Core.Storage+import Development.Shake.Internal.Core.Build+import Development.Shake.Internal.History.Shared+import Development.Shake.Internal.History.Cloud+import qualified General.TypeMap as TMap+import Control.Monad.Extra+import Data.Typeable+import Numeric.Extra+import Data.List.Extra+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import Data.Dynamic+import Data.Maybe+import Data.IORef.Extra+import System.Directory+import System.Time.Extra+import qualified Data.ByteString as BS++import Development.Shake.Internal.Core.Types+import Development.Shake.Internal.Core.Action+import Development.Shake.Internal.Core.Rules+import General.Pool+import Development.Shake.Internal.Progress+import Development.Shake.Internal.Value+import Development.Shake.Internal.Profile+import Development.Shake.Internal.Options+import Development.Shake.Internal.Errors+import General.Timing+import General.Thread+import General.Extra+import General.Cleanup+import Data.Monoid+import Prelude+++---------------------------------------------------------------------+-- MAKE++data RunState = RunState+    {opts :: ShakeOptions+    ,builtinRules :: Map.HashMap TypeRep BuiltinRule+    ,userRules :: TMap.Map UserRuleVersioned+    ,database :: Database+    ,curdir :: FilePath+    ,shared :: Maybe Shared+    ,cloud :: Maybe Cloud+    ,actions :: [(Stack, Action ())]+    }+++open :: Cleanup -> ShakeOptions -> Rules () -> IO RunState+open cleanup opts rs = withInit opts $ \opts@ShakeOptions{..} diagnostic _ -> do+    diagnostic $ pure "Starting run"+    SRules{actions, builtinRules, userRules} <- runRules opts rs++    diagnostic $ pure $ "Number of actions = " ++ show (length actions)+    diagnostic $ pure $ "Number of builtin rules = " ++ show (Map.size builtinRules) ++ " " ++ show (Map.keys builtinRules)+    diagnostic $ pure $ "Number of user rule types = " ++ show (TMap.size userRules)+    diagnostic $ pure $ "Number of user rules = " ++ show (sum (TMap.toList (userRuleSize . userRuleContents) userRules))++    checkShakeExtra shakeExtra+    curdir <- getCurrentDirectory++    database <- usingDatabase cleanup opts diagnostic builtinRules+    (shared, cloud) <- loadSharedCloud database opts builtinRules+    pure RunState{..}+++-- Prepare for a fresh run by changing Result to Loaded+reset :: RunState -> IO ()+reset RunState{..} = runLocked database $+    modifyAllMem database f+    where+        f (Ready r) = Loaded (snd <$> r)+        f (Failed _ x) = maybe Missing Loaded x+        f (Running _ x) = maybe Missing Loaded x -- shouldn't ever happen, but Loaded is least worst+        f x = x+++run :: RunState -> Bool -> [Action ()] -> IO [IO ()]+run RunState{..} oneshot actions2 =+    withInit opts $ \opts@ShakeOptions{..} diagnostic output -> do++        -- timings are a bit delicate, we want to make sure we clear them before we leave (so each run is fresh)+        -- but we also want to only print them if there is no exception, and have to caputre them before we clear them+        -- we use this variable to stash them away, then print after the exception handling block+        timingsToShow <- newIORef Nothing++        res <- withCleanup $ \cleanup -> do+            register cleanup $ do+                when (shakeTimings && shakeVerbosity >= Info) $+                    writeIORef timingsToShow . Just =<< getTimings+                resetTimings++            start <- offsetTime+            except <- newIORef (Nothing :: Maybe (String, ShakeException))+            let getFailure = fmap fst <$> readIORef except+            let raiseError err+                    | not shakeStaunch = throwIO err+                    | otherwise = do+                        let named = shakeAbbreviationsApply opts . shakeExceptionTarget+                        atomicModifyIORef except $ \v -> (Just $ fromMaybe (named err, err) v, ())+                        -- no need to print exceptions here, they get printed when they are wrapped++            after <- newIORef []+            absent <- newIORef []+            step <- incrementStep database+            getProgress <- usingProgress cleanup opts database step getFailure+            lintCurrentDirectory curdir "When running"++            watch <- lintWatch shakeLintWatch+            let ruleFinished+                    | isJust shakeLint = \k -> do+                        liftIO $ lintCurrentDirectory curdir $ show k+                        lintTrackFinished+                        liftIO $ watch $ show k+                    | otherwise = liftIO . watch . show++            addTiming "Running rules"+            locals <- newIORef []+            runPool (shakeThreads == 1) shakeThreads $ \pool -> do+                let global = Global applyKeyValue database pool cleanup start builtinRules output opts diagnostic ruleFinished after absent getProgress userRules shared cloud step oneshot+                -- give each action a stack to start with!+                forM_ (actions ++ map (emptyStack,) actions2) $ \(stack, act) -> do+                    let local = newLocal stack shakeVerbosity+                    addPool PoolStart pool $ runAction global local (act >> getLocal) $ \case+                        Left e -> raiseError =<< shakeException global stack e+                        Right local -> atomicModifyIORef_ locals (local:)++            whenJustM (readIORef except) (throwIO . snd)+            assertFinishedDatabase database+            let putWhen lvl msg = when (shakeVerbosity >= lvl) $ output lvl msg++            locals <- readIORef locals+            end <- start+            if null actions && null actions2 then+                putWhen Info "Warning: No want/action statements, nothing to do"+             else+                recordRoot step locals end database++            when (isJust shakeLint) $ do+                addTiming "Lint checking"+                lintCurrentDirectory curdir "After completion"+                checkValid diagnostic database (runLint builtinRules) =<< readIORef absent+                putWhen Verbose "Lint checking succeeded"+            when (shakeReport /= []) $ do+                addTiming "Profile report"+                forM_ shakeReport $ \file -> do+                    putWhen Info $ "Writing report to " ++ file+                    writeProfile file database+            when (shakeLiveFiles /= []) $ do+                addTiming "Listing live"+                diagnostic $ pure "Listing live keys"+                xs <- liveFiles database+                forM_ shakeLiveFiles $ \file -> do+                    putWhen Info $ "Writing live list to " ++ file+                    (if file == "-" then putStr else writeFile file) $ unlines xs++            res <- readIORef after+            addTiming "Cleanup"+            pure res++        whenJustM (readIORef timingsToShow) $+            putStr . unlines+        pure res+++-- | Run a set of IO actions, treated as \"after\" actions, typically returned from+--   'Development.Shake.Database.shakeRunDatabase'. The actions will be run with diagnostics+--   etc as specified in the 'ShakeOptions'.+shakeRunAfter :: ShakeOptions -> [IO ()] -> IO ()+shakeRunAfter _ [] = pure ()+shakeRunAfter opts after = withInit opts $ \ShakeOptions{..} diagnostic _ -> do+    let n = show $ length after+    diagnostic $ pure $ "Running " ++ n ++ " after actions"+    (time, _) <- duration $ sequence_ $ reverse after+    when (shakeTimings && shakeVerbosity >= Info) $+        putStrLn $ "(+ running " ++ show n ++ " after actions in " ++ showDuration time ++ ")"+++withInit :: ShakeOptions -> (ShakeOptions -> (IO String -> IO ()) -> (Verbosity -> String -> IO ()) -> IO a) -> IO a+withInit opts act =+    withCleanup $ \cleanup -> do+        opts@ShakeOptions{..} <- usingShakeOptions cleanup opts+        (diagnostic, output) <- outputFunctions opts <$> newLock+        act opts diagnostic output+++usingShakeOptions :: Cleanup -> ShakeOptions -> IO ShakeOptions+usingShakeOptions cleanup opts = do+    opts@ShakeOptions{..} <- if shakeThreads opts /= 0 then pure opts else do p <- getProcessorCount; pure opts{shakeThreads=p}+    when shakeLineBuffering $ usingLineBuffering cleanup+    usingNumCapabilities cleanup shakeThreads+    pure opts++outputFunctions :: ShakeOptions -> Lock -> (IO String -> IO (), Verbosity -> String -> IO ())+outputFunctions opts@ShakeOptions{..} outputLock = (diagnostic, output)+    where+        outputLocked v msg = withLock outputLock $ shakeOutput v msg++        diagnostic | shakeVerbosity < Diagnostic = const $ pure ()+                   | otherwise = \act -> do v <- act; outputLocked Diagnostic $ "% " ++ v+        output v = outputLocked v . shakeAbbreviationsApply opts+++usingProgress :: Cleanup -> ShakeOptions -> Database -> Step -> IO (Maybe String) -> IO (IO Progress)+usingProgress cleanup ShakeOptions{..} database step getFailure = do+    let getProgress = do+            failure <- getFailure+            stats <- progress database step+            pure stats{isFailure=failure}+    allocateThread cleanup $ shakeProgress getProgress+    pure getProgress++checkShakeExtra :: Map.HashMap TypeRep Dynamic -> IO ()+checkShakeExtra mp = do+    let bad = [(k,t) | (k,v) <- Map.toList mp, let t = dynTypeRep v, t /= k]+    case bad of+        (k,t):xs -> throwIO $ errorStructured "Invalid Map in shakeExtra"+            [("Key",Just $ show k),("Value type",Just $ show t)]+            (if null xs then "" else "Plus " ++ show (length xs) ++ " other keys")+        _ -> pure ()+++runLint :: Map.HashMap TypeRep BuiltinRule -> Key -> Value -> IO (Maybe String)+runLint mp k v = case Map.lookup (typeKey k) mp of+    Nothing -> pure Nothing+    Just BuiltinRule{..} -> builtinLint k v+++assertFinishedDatabase :: Database -> IO ()+assertFinishedDatabase database = do+    -- if you have anyone Waiting, and are not exiting with an error, then must have a complex recursion (see #400)+    status <- getKeyValues database+    let bad = [key | (key, Running{}) <- status]+    when (bad /= []) $+        throwM $ errorComplexRecursion (map show bad)+++liveFilesState :: RunState -> IO [FilePath]+liveFilesState RunState{..} = liveFiles database++profileState :: RunState -> FilePath -> IO ()+profileState RunState{..} file = writeProfile file database++liveFiles :: Database -> IO [FilePath]+liveFiles database = do+    status <- getKeyValues database+    let specialIsFileKey t = show (fst $ splitTyConApp t) == "FileQ"+    pure [show k | (k, Ready{}) <- status, specialIsFileKey $ typeKey k]++errorsState :: RunState -> IO [(String, SomeException)]+errorsState RunState{..} = do+    status <- getKeyValues database+    pure [(show k, e) | (k, Failed e _) <- status]+++checkValid :: (IO String -> IO ()) -> Database -> (Key -> Value -> IO (Maybe String)) -> [(Key, Key)] -> IO ()+checkValid diagnostic db check absent = do+    status <- getKeyValues db+    diagnostic $ pure "Starting validity/lint checking"++    -- TEST 1: Have values changed since being depended on+    -- Do not use a forM here as you use too much stack space+    bad <- (\f -> foldM f [] status) $ \seen v -> case v of+        (key, Ready Result{..}) -> do+            good <- check key $ fst result+            diagnostic $ pure $ "Checking if " ++ show key ++ " is " ++ show result ++ ", " ++ if isNothing good then "passed" else "FAILED"+            pure $ [(key, result, now) | Just now <- [good]] ++ seen+        _ -> pure seen+    unless (null bad) $ do+        let n = length bad+        throwM $ errorStructured+            ("Lint checking error - " ++ (if n == 1 then "value has" else show n ++ " values have")  ++ " changed since being depended upon")+            (intercalate [("",Just "")] [ [("Key", Just $ show key),("Old", Just $ show result),("New", Just now)]+                                        | (key, result, now) <- bad])+            ""++    -- TEST 2: Is anything from lintTrackWrite which promised not to exist actually been created+    exists <- getIdFromKey db+    bad <- pure [(parent,key) | (parent, key) <- Set.toList $ Set.fromList absent, isJust $ exists key]+    unless (null bad) $ do+        let n = length bad+        throwM $ errorStructured+            ("Lint checking error - " ++ (if n == 1 then "value" else show n ++ " values") ++ " did not have " ++ (if n == 1 then "its" else "their") ++ " creation tracked")+            (intercalate [("",Just "")] [ [("Rule", Just $ show parent), ("Created", Just $ show key)] | (parent,key) <- bad])+            ""++    diagnostic $ pure "Validity/lint check passed"+++---------------------------------------------------------------------+-- STORAGE++usingDatabase :: Cleanup -> ShakeOptions -> (IO String -> IO ()) -> Map.HashMap TypeRep BuiltinRule -> IO Database+usingDatabase cleanup opts diagnostic owitness = do+    let step = (typeRep (Proxy :: Proxy StepKey), (Ver 0, BinaryOp (const mempty) (const stepKey)))+    let root = (typeRep (Proxy :: Proxy Root), (Ver 0, BinaryOp (const mempty) (const rootKey)))+    witness<- pure $ Map.fromList+        [ (QTypeRep t, (version, BinaryOp (putDatabase putOp) (getDatabase getOp)))+        | (t,(version, BinaryOp{..})) <- step : root : Map.toList (Map.map (\BuiltinRule{..} -> (builtinVersion, builtinKey)) owitness)]+    (status, journal) <- usingStorage cleanup opts diagnostic witness+    journal<- pure $ \i k v -> journal (QTypeRep $ typeKey k) i (k, v)+    createDatabase status journal Missing+++incrementStep :: Database -> IO Step+incrementStep db = runLocked db $ do+    stepId <- mkId db stepKey+    v <- liftIO $ getKeyValueFromId db stepId+    step <- liftIO $ evaluate $ case v of+        Just (_, Loaded r) -> incStep $ fromStepResult r+        _ -> Step 1+    let stepRes = toStepResult step+    setMem db stepId stepKey $ Ready stepRes+    liftIO $ setDisk db stepId stepKey $ Loaded $ fmap snd stepRes+    pure step++toStepResult :: Step -> Result (Value, BS_Store)+toStepResult i = Result (newValue i, runBuilder $ putEx i) i i [] 0 []++fromStepResult :: Result BS_Store -> Step+fromStepResult = getEx . result+++recordRoot :: Step -> [Local] -> Seconds -> Database -> IO ()+recordRoot step locals (doubleToFloat -> end) db = runLocked db $ do+    rootId <- mkId db rootKey+    let local = localMergeMutable (newLocal emptyStack Info) locals+    let rootRes = Result+            {result = (newValue (), BS.empty)+            ,changed = step+            ,built = step+            ,depends = flattenDepends $ localDepends local+            ,execution = 0+            ,traces = flattenTraces $ addTrace (localTraces local) $ Trace BS.empty end end}+    setMem db rootId rootKey $ Ready rootRes+    liftIO $ setDisk db rootId rootKey $ Loaded $ fmap snd rootRes+++loadSharedCloud :: DatabasePoly k v -> ShakeOptions -> Map.HashMap TypeRep BuiltinRule -> IO (Maybe Shared, Maybe Cloud)+loadSharedCloud var opts owitness = do+    let mp = Map.fromList $ map (first $ show . QTypeRep) $ Map.toList owitness+    let wit = binaryOpMap $ \a -> maybe (error $ "loadSharedCloud, couldn't find map for " ++ show a) builtinKey $ Map.lookup a mp+    let wit2 = BinaryOp (\k -> putOp wit (show $ QTypeRep $ typeKey k, k)) (snd . getOp wit)+    let keyVers = [(k, builtinVersion v) | (k,v) <- Map.toList owitness]+    let ver = makeVer $ shakeVersion opts++    shared <- case shakeShare opts of+        Nothing -> pure Nothing+        Just x -> Just <$> newShared (shakeSymlink opts) wit2 ver x+    cloud <- case newCloud (runLocked var) (Map.map builtinKey owitness) ver keyVers $ shakeCloud opts of+        _ | null $ shakeCloud opts -> pure Nothing+        Nothing -> fail "shakeCloud set but Shake not compiled for cloud operation"+        Just res -> Just <$> res+    pure (shared, cloud)+++putDatabase :: (Key -> Builder) -> ((Key, Status) -> Builder)+putDatabase putKey (key, Loaded (Result x1 x2 x3 x4 x5 x6)) =+    putExN (putKey key) <> putExN (putEx x1) <> putEx x2 <> putEx x3 <> putEx x5 <> putExN (putEx x4) <> putEx x6+putDatabase _ (_, x) = throwImpure $ errorInternal $ "putWith, Cannot write Status with constructor " ++ statusType x+++getDatabase :: (BS.ByteString -> Key) -> BS.ByteString -> (Key, Status)+getDatabase getKey bs+    | (key, bs) <- getExN bs+    , (x1, bs) <- getExN bs+    , (x2, x3, x5, bs) <- binarySplit3 bs+    , (x4, x6) <- getExN bs+    = (getKey key, Loaded (Result x1 x2 x3 (getEx x4) x5 (getEx x6)))
+ src/Development/Shake/Internal/Core/Storage.hs view
@@ -0,0 +1,254 @@+{-# LANGUAGE ScopedTypeVariables, RecordWildCards, FlexibleInstances #-}+{-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving #-}+{-+This module stores the meta-data so its very important its always accurate+We can't rely on getting any exceptions or termination at the end, so we'd better write out a journal+We store a series of records, and if they contain twice as many records as needed, we compact+-}++module Development.Shake.Internal.Core.Storage(+    usingStorage+    ) where++import General.Chunks+import General.Cleanup+import General.Binary+import General.Intern+import Development.Shake.Internal.Options+import Development.Shake.Internal.Errors+import General.Timing+import General.FileLock+import qualified General.Ids as Ids++import Control.Exception.Extra+import Control.Monad.Extra+import Data.Monoid+import Data.Either.Extra+import Data.Time+import Data.Char+import Data.Word+import System.Info+import Development.Shake.Classes+import Numeric+import General.Extra+import Data.List.Extra+import Data.Maybe+import System.FilePath+import qualified Data.ByteString.UTF8 as UTF8+import qualified Data.HashMap.Strict as Map++import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString as BS8+import Prelude+++-- Increment every time the on-disk format/semantics change,+-- @x@ is for the users version number+databaseVersion :: String -> String+-- THINGS I WANT TO DO ON THE NEXT CHANGE+-- * Change filepaths to store a 1 byte prefix saying 8bit ASCII or UTF8+-- * Duration and Time should be stored as number of 1/10000th seconds Int32+databaseVersion x = "SHAKE-DATABASE-14-" ++ os ++ "-" ++ arch ++ "-" ++  s ++ "\r\n"+    where s = tailErr $ init $ show x -- call show, then take off the leading/trailing quotes+                                      -- ensures we do not get \r or \n in the user portion+++messageCorrupt :: FilePath -> SomeException -> IO [String]+messageCorrupt dbfile err = do+    msg <- showException err+    pure $+        ("Error when reading Shake database " ++ dbfile) :+        map ("  "++) (lines msg) +++        ["All files will be rebuilt"]+++messageDatabaseVersionChange :: FilePath -> BS.ByteString -> BS.ByteString -> [String]+messageDatabaseVersionChange dbfile old new =+    ["Shake database version changed (either shake library version, or shakeVersion):"+    ,"  File:         " ++ dbfile+    ,"  Old version:  " ++ disp (limit $ BS.unpack old)+    ,"  New version:  " ++ disp (BS.unpack new)+    ,"All rules will be rebuilt"]+    where+        limit x = let (a,b) = splitAt 200 x in a ++ (if null b then "" else "...")+        disp = map (\x -> if isPrint x && isAscii x then x else '?') . takeWhile (`notElem` ("\r\n" :: String))+++messageMissingTypes :: FilePath -> [String] -> [String]+messageMissingTypes dbfile types =+    ["Shake database rules have changed for the following types:"+    ,"  File:  " ++ dbfile] +++    ["  Type:  " ++ x | x <- types] +++    ["All rules using these types will be rebuilt"]+++-- | Storage of heterogeneous things. In the particular case of Shake,+--   k ~ QTypeRep, v ~ (Key, Status{Value}).+--+--   The storage starts with a witness table saying what can be contained.+--   If any entries in the witness table don't have a current Witness then a fake+--   error witness is manufactured. If the witness ever changes the entire DB is+--   rewritten.+usingStorage+    :: (Show k, Eq k, Hashable k, NFData k, Show v, NFData v)+    => Cleanup+    -> ShakeOptions                                    -- ^ Storage options+    -> (IO String -> IO ())                            -- ^ Logging function+    -> Map.HashMap k (Ver, BinaryOp v)                 -- ^ Witnesses+    -> IO (Ids.Ids v, k -> Id -> v -> IO ())+usingStorage _ ShakeOptions{..} diagnostic _ | shakeFiles == "/dev/null" = do+    diagnostic $ pure "Using in-memory database"+    ids <- Ids.empty+    pure (ids, \_ _ _ -> pure ())++usingStorage cleanup ShakeOptions{..} diagnostic witness = do+    let lockFile = shakeFiles </> ".shake.lock"+    diagnostic $ pure $ "Before usingLockFile on " ++ lockFile+    usingLockFile cleanup lockFile+    diagnostic $ pure "After usingLockFile"++    let dbfile = shakeFiles </> ".shake.database"+    createDirectoryRecursive shakeFiles++    -- complete a partially failed compress+    whenM (restoreChunksBackup dbfile) $ do+        unexpected "Backup file exists, restoring over the previous file\n"+        diagnostic $ pure "Backup file move to original"++    addTiming "Database read"+    h <- usingChunks cleanup dbfile shakeFlush+    let corrupt+            | not shakeStorageLog = resetChunksCorrupt Nothing h+            | otherwise = do+                let file = dbfile <.> "corrupt"+                resetChunksCorrupt (Just file) h+                unexpected $ "Backup of corrupted file stored at " ++ file ++ "\n"++    -- check the version information matches+    let ver = BS.pack $ databaseVersion shakeVersion+    oldVer <- readChunkMax h $ fromIntegral $ BS.length ver + 100000+    let verEq = Right ver == oldVer+    when (not shakeVersionIgnore && not verEq && oldVer /= Left BS.empty) $ do+        outputErr $ messageDatabaseVersionChange dbfile (fromEither oldVer) ver+        corrupt++    (!witnessNew, !save) <- evaluate $ saveWitness witness+    witnessOld <- readChunk h+    ids <- case witnessOld of+        Left _ -> do+            resetChunksCorrupt Nothing h+            pure Nothing+        Right witnessOld ->  handleBool (not . isAsyncException) (\err -> do+            outputErr =<< messageCorrupt dbfile err+            corrupt+            pure Nothing) $ do++            (!missing, !load) <- evaluate $ loadWitness witness witnessOld+            when (missing /= []) $ outputErr $ messageMissingTypes dbfile missing+            ids <- Ids.empty+            let raw bs = "[len " ++ show (BS.length bs) ++ "] " ++ concat+                            [['0' | length c == 1] ++ c | x <- BS8.unpack bs, let c = showHex x ""]+            let go !i = do+                    v <- readChunk h+                    case v of+                        Left e -> do+                            let slop = fromIntegral $ BS.length e+                            when (slop > 0) $ unexpected $ "Last " ++ show slop ++ " bytes do not form a whole record\n"+                            diagnostic $ pure $ "Read " ++ show i ++ " chunks, plus " ++ show slop ++ " slop"+                            pure i+                        Right bs | (id, Just (k,v)) <- load bs -> do+                            evaluate $ rnf k+                            evaluate $ rnf v+                            Ids.insert ids id (k,v)+                            diagnostic $ do+                                let pretty (Left x) = "FAILURE: " ++ show x+                                    pretty (Right x) = x+                                x2 <- try_ $ evaluate $ let s = show v in rnf s `seq` s+                                pure $ "Chunk " ++ show i ++ " " ++ raw bs ++ " " ++ show id ++ " = " ++ pretty x2+                            go $ i+1+                        Right bs -> do+                            diagnostic $ pure $ "Chunk " ++ show i ++ " " ++ raw bs ++ " UNKNOWN WITNESS"+                            go i+            countItems <- go 0+            countDistinct <- Ids.sizeUpperBound ids+            diagnostic $ pure $ "Found at most " ++ show countDistinct ++ " distinct entries out of " ++ show countItems++            when (countItems > countDistinct*2 || not verEq || witnessOld /= witnessNew) $ do+                addTiming "Database compression"+                resetChunksCompact h $ \out -> do+                    out $ putEx ver+                    out $ putEx witnessNew+                    Ids.forWithKeyM_ ids $ \i (k,v) -> out $ save k i v+            Just <$> Ids.forCopy ids snd++    ids <- case ids of+        Just ids -> pure ids+        Nothing -> do+            writeChunk h $ putEx ver+            writeChunk h $ putEx witnessNew+            Ids.empty++    addTiming "With database"+    out <- usingWriteChunks cleanup h+    pure (ids, \k i v -> out $ save k i v)+    where+        unexpected x = when shakeStorageLog $ do+            t <- getCurrentTime+            appendFile (shakeFiles </> ".shake.storage.log") $ "\n[" ++ show t ++ "]: " ++ trimEnd x ++ "\n"+        outputErr x = do+            when (shakeVerbosity >= Warn) $ shakeOutput Warn $ unlines x+            unexpected $ unlines x+++-- | A list oft witnesses, saved+type Witnesses = BS.ByteString++-- | The version and key, serialised+newtype Witness = Witness BS.ByteString+    deriving (Eq, Hashable, Ord)++toWitness :: Show k => Ver -> k -> Witness+toWitness (Ver v) k = Witness $ UTF8.fromString (show k ++ (if v == 0 then "" else ", v" ++ show v))++instance BinaryEx [Witness] where+    putEx xs = putEx [x | Witness x <- xs]+    getEx = map Witness . getEx+++-- | Given the current witness table, and the serialised one from last time, return+--   (witnesses that got removed, way to deserialise an entry into an Id, and (if the witness remains) the key and value)+loadWitness :: forall k v . Show k => Map.HashMap k (Ver, BinaryOp v) -> Witnesses -> ([String], BS.ByteString -> (Id, Maybe (k, v)))+loadWitness mp bs = (,) missing $ seq ind $ \bs ->+            let (wInd :: Word16, i :: Id, bs2) = binarySplit2 bs+            in case ind (fromIntegral wInd) of+                    Nothing -> throwImpure $ errorInternal $ "Witness index out of bounds, " ++ show wInd+                    Just f -> (i, f bs2)+    where+        ws :: [Witness] = getEx bs+        missing = [UTF8.toString w | (i, Witness w) <- zipFrom 0 ws, isNothing $ fromJust (ind i) BS.empty]++        mp2 :: Map.HashMap Witness (k, BinaryOp v) = Map.fromList [(toWitness ver k, (k, bin)) | (k,(ver,bin)) <- Map.toList mp]++        ind :: (Int -> Maybe (BS.ByteString -> Maybe (k, v))) = seq mp2 $ fastAt $ flip map ws $ \w ->+            case Map.lookup w mp2 of+                Nothing -> const Nothing+                Just (k, BinaryOp{..}) -> \bs -> Just (k, getOp bs)+++saveWitness :: forall k v . (Eq k, Hashable k, Show k) => Map.HashMap k (Ver, BinaryOp v) -> (Witnesses, k -> Id -> v -> Builder)+saveWitness mp+    | Map.size mp > fromIntegral (maxBound :: Word16) = throwImpure $ errorInternal $ "Number of distinct witness types exceeds limit, got " ++ show (Map.size mp)+    | otherwise = (runBuilder $ putEx ws+                  ,mpSave `seq` \k -> fromMaybe (throwImpure $ errorInternal $ "Don't know how to save, " ++ show k) $ Map.lookup k mpSave)+    where+        -- the entries in the witness table (in a stable order, to make it more likely to get a good equality)+        ws :: [Witness] = sort $ map (\(k,(ver,_)) -> toWitness ver k) $ Map.toList mp++        -- an index for each of the witness entries+        wsIndex :: Map.HashMap Witness Word16 = Map.fromList $ zip ws [0 :: Word16 ..]++        -- the save functions+        mpSave :: Map.HashMap k (Id -> v -> Builder) = flip Map.mapWithKey mp $+            \k (ver,BinaryOp{..}) ->+                let tag = putEx $ wsIndex Map.! toWitness ver k+                in \(Id w) v -> tag <> putEx w <> putOp v
+ src/Development/Shake/Internal/Core/Types.hs view
@@ -0,0 +1,532 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables, DeriveDataTypeable, ViewPatterns #-}+{-# LANGUAGE ExistentialQuantification, DeriveFunctor, RecordWildCards, FlexibleInstances #-}++module Development.Shake.Internal.Core.Types(+    BuiltinRun, BuiltinLint, BuiltinIdentity,+    RunMode(..), RunResult(..), RunChanged(..),+    UserRule(..), UserRuleVersioned(..), userRuleSize,+    BuiltinRule(..), Global(..), Local(..), Action(..), runAction, addDiscount,+    newLocal, localClearMutable, localMergeMutable,+    Traces, newTrace, addTrace, flattenTraces,+    DependsList, flattenDepends, enumerateDepends, addDepends, addDepends1, newDepends,+    Stack, Step(..), Result(..), Database, DatabasePoly(..), Depends(..), Status(..), Trace(..), BS_Store,+    getResult, exceptionStack, statusType, addStack, addCallStack,+    incStep, emptyStack, topStack, showTopStack,+    stepKey, StepKey(..),+    rootKey, Root(..)+    ) where++import Control.Monad.IO.Class+import Control.DeepSeq+import Foreign.Storable+import Data.Word+import Data.Typeable+import General.Binary+import Data.Maybe+import Data.List+import Control.Exception+import General.Extra+import Development.Shake.Internal.Core.Database+import Development.Shake.Internal.History.Shared+import Development.Shake.Internal.History.Cloud+import Development.Shake.Internal.History.Types+import Development.Shake.Internal.Errors+import qualified General.TypeMap as TMap+import Data.IORef+import qualified Data.ByteString.Char8 as BS+import Numeric.Extra+import System.Time.Extra+import General.Intern(Id)+import qualified Data.HashSet as Set+import qualified Data.HashMap.Strict as Map+import Data.Tuple.Extra++import General.Pool+import Development.Shake.Internal.Core.Monad+import Development.Shake.Internal.Value+import Development.Shake.Internal.Options+import Development.Shake.Classes+import Data.Semigroup+import General.Cleanup+import Control.Monad.Fail+import Prelude+++---------------------------------------------------------------------+-- UNDERLYING DATA TYPE++-- | The 'Action' monad, use 'liftIO' to raise 'IO' actions into it, and 'Development.Shake.need' to execute files.+--   Action values are used by 'addUserRule' and 'action'. The 'Action' monad tracks the dependencies of a rule.+--   To raise an exception call 'error', 'fail' or @'liftIO' . 'throwIO'@.+--+--   The 'Action' type is both a 'Monad' and 'Applicative'. Anything that is depended upon applicatively+--   will have its dependencies run in parallel. For example,+--   @'Development.Shake.Internal.Rules.File.need' [\"a\"] '*>' 'Development.Shake.Internal.Rules.File.need' [\"b\"]@+--   is equivalent to @'need' [\"a\", \"b\"]@.+--+--   Note that since Shake 0.18, the non-capturing monadic bind ('>>') will also run its dependencies in parallel.+--   For example,+--   @'Development.Shake.Internal.Rules.File.need' [\"a\"] '>>' 'Development.Shake.Internal.Rules.File.need' [\"b\"]@+--   is also equivalent to @'Development.Shake.Internal.Rules.File.need' [\"a\", \"b\"]@.+newtype Action a = Action {fromAction :: RAW ([String],[Key]) [Value] Global Local a}+    deriving (Functor, Applicative, Monad, MonadIO, Typeable, Semigroup, Monoid, MonadFail)++runAction :: Global -> Local -> Action a -> Capture (Either SomeException a)+runAction g l (Action x) = runRAW (fromAction . build) g l x+    where+        -- first argument is a list of call stacks, since build only takes one we use the first+        -- they are very probably all identical...+        build :: [([String], [Key])] -> Action [[Value]]+        build [] = pure []+        build ks@((callstack,_):_) = do+            let kss = map snd ks+            unconcat kss <$> globalBuild g callstack (concat kss)+++---------------------------------------------------------------------+-- PUBLIC TYPES++-- | What mode a rule is running in, passed as an argument to 'BuiltinRun'.+data RunMode+    = RunDependenciesSame -- ^ My dependencies have not changed.+    | RunDependenciesChanged -- ^ At least one of my dependencies from last time have changed, or I have no recorded dependencies.+      deriving (Eq,Show)++instance NFData RunMode where rnf x = x `seq` ()++-- | How the output of a rule has changed.+data RunChanged+    = ChangedNothing -- ^ Nothing has changed.+    | ChangedStore -- ^ The stored value has changed, but in a way that should be considered identical (used rarely).+    | ChangedRecomputeSame -- ^ I recomputed the value and it was the same.+    | ChangedRecomputeDiff -- ^ I recomputed the value and it was different.+      deriving (Eq,Show)++instance NFData RunChanged where rnf x = x `seq` ()+++-- | The result of 'BuiltinRun'.+data RunResult value = RunResult+    {runChanged :: RunChanged+        -- ^ How has the 'RunResult' changed from what happened last time.+    ,runStore :: BS.ByteString+        -- ^ The value to store in the Shake database.+    ,runValue :: value+        -- ^ The value to return from 'Development.Shake.Rule.apply'.+    } deriving Functor++instance NFData value => NFData (RunResult value) where+    rnf (RunResult x1 x2 x3) = rnf x1 `seq` x2 `seq` rnf x3++++---------------------------------------------------------------------+-- UTILITY TYPES++newtype Step = Step Word32 deriving (Eq,Ord,Show,Storable,BinaryEx,NFData,Hashable,Typeable)++incStep (Step i) = Step $ i + 1+++-- To simplify journaling etc we smuggle the Step in the database, with a special StepKey+newtype StepKey = StepKey ()+    deriving (Show,Eq,Typeable,Hashable,Binary,BinaryEx,NFData)++stepKey :: Key+stepKey = newKey $ StepKey ()+++-- To make sure profiling has a complete view of what was demanded and all top-level 'action'+-- things we fake up a Root node representing everything that was demanded+newtype Root = Root () deriving (Eq,Typeable,Hashable,Binary,BinaryEx,NFData)++instance Show Root where+    show (Root ()) = "Root"++rootKey :: Key+rootKey = newKey $ Root ()+++---------------------------------------------------------------------+-- CALL STACK++-- Invariant: Every key must have its Id in the set+data Stack = Stack (Maybe Key) [Either Key [String]] !(Set.HashSet Id) deriving Show++exceptionStack :: Stack -> SomeException -> ShakeException+exceptionStack stack@(Stack _ xs1 _) (callStackFromException -> (xs2, e)) =+    ShakeException+        (showTopStack stack)+        (xs ++ ["* Raised the exception:" | not $ null xs])+        e+    where+        xs = concatMap f $ reverse xs1 ++ [Right xs2]+        f (Left x) = ["* Depends on: " ++ show x]+        f (Right x) = map ("  at " ++) x+++showTopStack :: Stack -> String+showTopStack = maybe "<unknown>" show . topStack++addStack :: Id -> Key -> Stack -> Either SomeException Stack+addStack i k (Stack _ ks is)+    | i `Set.member` is = Left $ toException $ exceptionStack stack2 $ errorRuleRecursion (typeKey k) (show k)+    | otherwise = Right stack2+    where stack2 = Stack (Just k) (Left k:ks) (Set.insert i is)++addCallStack :: [String] -> Stack -> Stack+-- use group/head to squash adjacent duplicates, e.g. a want does an action and a need, both of which get the same location+addCallStack xs (Stack t a b) = Stack t (Right xs : dropWhile (== Right xs) a) b++topStack :: Stack -> Maybe Key+topStack (Stack t _ _) = t++emptyStack :: Stack+emptyStack = Stack Nothing [] Set.empty+++---------------------------------------------------------------------+-- TRACE++data Trace = Trace+    {traceMessage ::  {-# UNPACK #-} !BS.ByteString+    ,traceStart :: {-# UNPACK #-} !Float+    ,traceEnd :: {-# UNPACK #-} !Float+    }+    deriving Show++instance NFData Trace where+    rnf x = x `seq` () -- all strict atomic fields++instance BinaryEx Trace where+    putEx (Trace a b c) = putEx b <> putEx c <> putEx a+    getEx x | (b,c,a) <- binarySplit2 x = Trace a b c++instance BinaryEx [Trace] where+    putEx = putExList . map putEx+    getEx = map getEx . getExList++newTrace :: String -> Seconds -> Seconds -> Trace+newTrace msg start stop = Trace (BS.pack msg) (doubleToFloat start) (doubleToFloat stop)+++---------------------------------------------------------------------+-- CENTRAL TYPES++-- Things stored under OneShot are not required if we only do one compilation,+-- but are if we do multiple, as we have to reset the database each time.+-- globalOneShot controls that, and gives us a small memory optimisation.+type OneShot a = a++data Status+    = Ready !(Result (Value, OneShot BS_Store)) -- ^ I have a value+    | Failed !SomeException !(OneShot (Maybe (Result BS_Store))) -- ^ I have been run and raised an error+    | Loaded !(Result BS_Store) -- ^ Loaded from the database+    | Running !(NoShow (Either SomeException (Result (Value, BS_Store)) -> Locked ())) (Maybe (Result BS_Store)) -- ^ Currently in the process of being checked or built+    | Missing -- ^ I am only here because I got into the Intern table+      deriving Show++instance NFData Status where+    rnf x = case x of+        Ready x -> rnf x+        Failed x y -> rnfException x `seq` rnf y+        Loaded x -> rnf x+        Running _ x -> rnf x -- Can't RNF a waiting, but also unnecessary+        Missing -> ()+        where+            -- best we can do for an arbitrary exception+            rnfException = rnf . show+++data Result a = Result+    {result :: !a -- ^ the result associated with the Key+    ,built :: {-# UNPACK #-} !Step -- ^ when it was actually run+    ,changed :: {-# UNPACK #-} !Step -- ^ the step for deciding if it's valid+    ,depends :: ![Depends] -- ^ dependencies (don't run them early)+    ,execution :: {-# UNPACK #-} !Float -- ^ how long it took when it was last run (seconds)+    ,traces :: ![Trace] -- ^ a trace of the expensive operations (start/end in seconds since beginning of run)+    } deriving (Show,Functor)++instance NFData a => NFData (Result a) where+    -- ignore unpacked fields+    rnf (Result a _ _ b _ c) = rnf a `seq` rnf b `seq` rnf c++statusType Ready{} = "Ready"+statusType Failed{} = "Failed"+statusType Loaded{} = "Loaded"+statusType Running{} = "Running"+statusType Missing{} = "Missing"+++getResult :: Status -> Maybe (Result (Either BS_Store Value))+getResult (Ready r) = Just $ Right . fst <$> r+getResult (Loaded r) = Just $ Left <$> r+getResult (Running _ r) = fmap Left <$> r+getResult _ = Nothing+++---------------------------------------------------------------------+-- OPERATIONS++newtype Depends = Depends {fromDepends :: [Id]}+    deriving (NFData, Semigroup, Monoid)++instance Show Depends where+    -- Appears in diagnostic output and the Depends ctor is just verbose+    show = show . fromDepends++instance BinaryEx Depends where+    putEx (Depends xs) = putExStorableList xs+    getEx = Depends . getExStorableList++instance BinaryEx [Depends] where+    putEx = putExList . map putEx+    getEx = map getEx . getExList++data DependsList+    = DependsNone+    | DependsDirect [Depends]+    | DependsSequence DependsList DependsList+    | DependsSequence1 DependsList Depends+    | DependsParallel [DependsList]++-- Create a new set of depends, from a list in the right order+newDepends :: [Depends] -> DependsList+newDepends = DependsDirect++-- Add two sequences of dependencies in order+addDepends :: DependsList -> DependsList -> DependsList+addDepends = DependsSequence++addDepends1 :: DependsList -> Depends -> DependsList+addDepends1 = DependsSequence1++-- Two goals here, merge parallel lists so they retain as much leading parallelism as possible+-- Afterwards each Id must occur at most once and there are no empty Depends+flattenDepends :: DependsList -> [Depends]+flattenDepends d = fMany Set.empty $ flat d []+    where+        flat :: DependsList -> [Depends] -> [Depends]+        flat DependsNone rest = rest+        flat (DependsDirect xs) rest = xs ++ rest+        flat (DependsSequence xs ys) rest = flat xs $ flat ys rest+        flat (DependsSequence1 xs y) rest = flat xs $ y:rest+        -- for each element of xs, we want to pull off the things that must be done first+        -- and then the stuff that can be done later+        flat (DependsParallel xs) rest = map mconcat xss ++ rest+            where xss = transpose $ map (`flat` []) xs++        fMany _ [] = []+        fMany seen (Depends d:ds) = [Depends d2 | d2 /= []] ++ fMany seen2 ds+            where (d2,seen2) = fOne seen d++        fOne seen [] = ([], seen)+        fOne seen (x:xs) | x `Set.member` seen = fOne seen xs+        fOne seen (x:xs) = first (x:) $ fOne (Set.insert x seen) xs+++++-- List all the dependencies in whatever order you wish, used for linting+enumerateDepends :: DependsList -> [Depends]+enumerateDepends d = f d []+    where+        f DependsNone rest = rest+        f (DependsDirect xs) rest = xs ++ rest+        f (DependsSequence xs ys) rest = f xs $ f ys rest+        f (DependsSequence1 xs y) rest = f xs (y:rest)+        f (DependsParallel []) rest = rest+        f (DependsParallel (x:xs)) rest = f x $ f (DependsParallel xs) rest+++-- | Define a rule between @key@ and @value@. As an example, a typical 'BuiltinRun' will look like:+--+-- > run key oldStore mode = do+-- >     ...+-- >     pure $ RunResult change newStore newValue+--+--   Where you have:+--+-- * @key@, how to identify individual artifacts, e.g. with file names.+--+-- * @oldStore@, the value stored in the database previously, e.g. the file modification time.+--+-- * @mode@, either 'RunDependenciesSame' (none of your dependencies changed, you can probably not rebuild) or+--   'RunDependenciesChanged' (your dependencies changed, probably rebuild).+--+-- * @change@, usually one of either 'ChangedNothing' (no work was required) or 'ChangedRecomputeDiff'+--   (I reran the rule and it should be considered different).+--+-- * @newStore@, the new value to store in the database, which will be passed in next time as @oldStore@.+--+-- * @newValue@, the result that 'Development.Shake.Rule.apply' will return when asked for the given @key@.+type BuiltinRun key value+    = key+    -> Maybe BS.ByteString+    -> RunMode+    -> Action (RunResult value)++-- | The action performed by @--lint@ for a given @key@/@value@ pair.+--   At the end of the build the lint action will be called for each @key@ that was built this run,+--   passing the @value@ it produced. Return 'Nothing' to indicate the value has not changed and+--   is acceptable, or 'Just' an error message to indicate failure.+--+--   For builtin rules where the value is expected to change, or has no useful checks to perform.+--   use 'Development.Shake.Rules.noLint'.+type BuiltinLint key value = key -> value -> IO (Maybe String)+++-- | Produce an identity for a @value@ that can be used to do direct equality. If you have a custom+--   notion of equality then the result should return only one member from each equivalence class,+--   as values will be compared for literal equality.+--   The result of the identity should be reasonably short (if it is excessively long, hash it).+--+--   For rules where the value is never compatible use 'Development.Shake.Rules.noIdentity', which+--   returns 'Nothing'. This will disable shared caches of anything that depends on it.+type BuiltinIdentity key value = key -> value -> Maybe BS.ByteString++data BuiltinRule = BuiltinRule+    {builtinLint :: BuiltinLint Key Value+    ,builtinIdentity :: BuiltinIdentity Key Value+    ,builtinRun :: BuiltinRun Key Value+    ,builtinKey :: BinaryOp Key+    ,builtinVersion :: Ver+    ,builtinLocation :: String+    }++-- | A 'UserRule' data type, representing user-defined rules associated with a particular type.+--   As an example 'Development.Shake.?>' and 'Development.Shake.%>' will add entries to the 'UserRule' data type.+data UserRule a+-- > priority p1 (priority p2 x) == priority p1 x+-- > priority p (x `ordered` y) = priority p x `ordered` priority p y+-- > priority p (x `unordered` y) = priority p x `unordered` priority p y+-- > ordered is associative+-- > unordered is associative and commutative+-- > alternative does not obey priorities, until picking the best one+    = UserRule a -- ^ Added to the state with @'addUserRule' :: Typeable a => a -> 'Rules' ()@.+    | Unordered [UserRule a] -- ^ Rules combined with the 'Monad' \/ 'Monoid'.+    | Priority Double (UserRule a) -- ^ Rules defined under 'priority'.+    | Alternative (UserRule a) -- ^ Rule defined under 'alternatives', matched in order.+    | Versioned Ver (UserRule a) -- ^ Rule defined under 'versioned', attaches a version.+      deriving (Eq,Show,Functor,Typeable)++data UserRuleVersioned a = UserRuleVersioned+    {userRuleVersioned :: Bool -- ^ Does Versioned exist anywhere within userRuleContents+    ,userRuleContents :: UserRule a -- ^ The actual rules+    }++instance Semigroup (UserRuleVersioned a) where+    UserRuleVersioned b1 x1 <> UserRuleVersioned b2 x2 = UserRuleVersioned (b1 || b2) (x1 <> x2)++instance Monoid (UserRuleVersioned a) where+    mempty = UserRuleVersioned False mempty+    mappend = (<>)++instance Semigroup (UserRule a) where+    x <> y = Unordered [x,y]++instance Monoid (UserRule a) where+    mempty = Unordered []+    mappend = (<>)++userRuleSize :: UserRule a -> Int+userRuleSize UserRule{} = 1+userRuleSize (Unordered xs) = sum $ map userRuleSize xs+userRuleSize (Priority _ x) = userRuleSize x+userRuleSize (Alternative x) = userRuleSize x+userRuleSize (Versioned _ x) = userRuleSize x+++type Database = DatabasePoly Key Status++-- global constants of Action+data Global = Global+    {globalBuild :: [String] -> [Key] -> Action [Value]+    ,globalDatabase :: Database -- ^ Database, contains knowledge of the state of each key+    ,globalPool :: Pool -- ^ Pool, for queuing new elements+    ,globalCleanup :: Cleanup -- ^ Cleanup operations+    ,globalTimestamp :: IO Seconds -- ^ Clock saying how many seconds through the build+    ,globalRules :: Map.HashMap TypeRep BuiltinRule -- ^ Rules for this build+    ,globalOutput :: Verbosity -> String -> IO () -- ^ Output function+    ,globalOptions  :: ShakeOptions -- ^ Shake options+    ,globalDiagnostic :: IO String -> IO () -- ^ Debugging function+    ,globalRuleFinished :: Key -> Action () -- ^ actions to run after each rule+    ,globalAfter :: IORef [IO ()] -- ^ Operations to run on success, e.g. removeFilesAfter+    ,globalTrackAbsent :: IORef [(Key, Key)] -- ^ Tracked things, in rule fst, snd must be absent+    ,globalProgress :: IO Progress -- ^ Request current progress state+    ,globalUserRules :: TMap.Map UserRuleVersioned+    ,globalShared :: Maybe Shared -- ^ The active shared state, if any+    ,globalCloud :: Maybe Cloud+    ,globalStep :: {-# UNPACK #-} !Step+    ,globalOneShot :: Bool -- ^ I am running in one-shot mode so don't need to store BS's for Result/Failed+    }++-- local variables of Action+data Local = Local+    -- constants+    {localStack :: Stack -- ^ The stack that ran to get here.+    ,localBuiltinVersion :: Ver -- ^ The builtinVersion of the rule you are running+    -- stack scoped local variables+    ,localVerbosity :: Verbosity -- ^ Verbosity, may be changed locally+    ,localBlockApply ::  Maybe String -- ^ Reason to block apply, or Nothing to allow+    -- mutable local variables+    ,localDepends :: DependsList -- ^ Dependencies that we rely on, morally a list of sets+    ,localDiscount :: !Seconds -- ^ Time spend building dependencies (may be negative for parallel)+    ,localTraces :: Traces -- ^ Traces that have occurred+    ,localTrackAllows :: [Key -> Bool] -- ^ Things that are allowed to be used+    ,localTrackRead :: [Key] -- ^ Calls to 'lintTrackRead'+    ,localTrackWrite :: [Key] -- ^ Calls to 'lintTrackWrite'+    ,localProduces :: [(Bool, FilePath)] -- ^ Things this rule produces, True to check them+    ,localHistory :: !Bool -- ^ Is it valid to cache the result+    }++data Traces+    = TracesNone -- no traces+    | TracesSequence1 Traces Trace -- Like TracesSequence but with 1 element+    | TracesSequence Traces Traces -- first the Traces happened, then Traces that happened after+    | TracesParallel [Traces] -- these traces happened in parallel with each other++flattenTraces :: Traces -> [Trace]+flattenTraces t = f t []+    where+        f TracesNone rest = rest+        f (TracesSequence1 a b) rest = f a (b:rest)+        f (TracesSequence a b) rest = f a $ f b rest+        f (TracesParallel []) rest = rest+        -- Might want to resort them by time started?+        f (TracesParallel (x:xs)) rest = f x $ f (TracesParallel xs) rest++addTrace :: Traces -> Trace -> Traces+addTrace ts t = ts `TracesSequence1` t++addDiscount :: Seconds -> Local -> Local+addDiscount s l = l{localDiscount = s + localDiscount l}++newLocal :: Stack -> Verbosity -> Local+newLocal stack verb = Local stack (Ver 0) verb Nothing DependsNone 0 TracesNone [] [] [] [] True++-- Clear all the local mutable variables+localClearMutable :: Local -> Local+localClearMutable Local{..} = (newLocal localStack localVerbosity){localBlockApply=localBlockApply, localBuiltinVersion=localBuiltinVersion}++-- Merge, works well assuming you clear the variables first with localClearMutable.+-- Assume the first was run sequentially, and the list in parallel.+localMergeMutable :: Local -> [Local] -> Local+-- don't construct with RecordWildCards so any new fields raise an error+localMergeMutable root xs = Local+    -- immutable/stack that need copying+    {localStack = localStack root+    ,localBuiltinVersion = localBuiltinVersion root+    ,localVerbosity = localVerbosity root+    ,localBlockApply = localBlockApply root+    -- mutable locals that need integrating+    -- note that a lot of the lists are stored in reverse, assume root happened first+    ,localDepends = DependsParallel (map localDepends xs) `DependsSequence` localDepends root+    ,localDiscount = sum $ map localDiscount $ root : xs+    ,localTraces = TracesParallel (map localTraces xs) `TracesSequence` localTraces root+    ,localTrackAllows = localTrackAllows root ++ concatMap localTrackAllows xs+    ,localTrackRead = localTrackRead root ++ concatMap localTrackRead xs+    ,localTrackWrite = localTrackWrite root ++ concatMap localTrackWrite xs+    ,localProduces = concatMap localProduces xs ++ localProduces root+    ,localHistory = all localHistory $ root:xs+    }
+ src/Development/Shake/Internal/Demo.hs view
@@ -0,0 +1,121 @@++-- | Demo tutorial, accessed with --demo+module Development.Shake.Internal.Demo(demo) where++import Development.Shake.Internal.Paths+import Development.Shake.Command++import Control.Exception.Extra+import Control.Monad+import Data.List.Extra+import Data.Maybe+import System.Directory+import System.Exit+import System.FilePath+import General.Extra+import Development.Shake.FilePath(exe)+import System.IO+import System.Info.Extra+++demo :: Bool -> IO ()+demo auto = do+    hSetBuffering stdout NoBuffering+    putStrLn $ "% Welcome to the Shake v" ++ shakeVersionString ++ " demo mode!"++    putStr "% Detecting machine configuration... "+    hasManual <- hasManualData+    ghc <- isJust <$> findExecutable "ghc"+    (gcc, gccPath) <- findGcc+    shakeLib <- wrap $ fmap (not . null . words . fromStdout) (cmd ("ghc-pkg list --simple-output shake" :: String))+    ninja <- findExecutable "ninja"+    putStrLn "done\n"++    let path = if isWindows then "%PATH%" else "$PATH"+    require ghc $ "% You don't have 'ghc' on your " ++ path ++ ", which is required to run the demo."+    require gcc $ "% You don't have 'gcc' on your " ++ path ++ ", which is required to run the demo."+    require shakeLib "% You don't have the 'shake' library installed with GHC, which is required to run the demo."+    require hasManual "% You don't have the Shake data files installed, which are required to run the demo."++    empty <- all (all (== '.')) <$> getDirectoryContents "."+    dir <- if empty then getCurrentDirectory else do+        home <- getHomeDirectory+        dir <- getDirectoryContents home+        pure $ home </> headErr (map ("shake-demo" ++) ("":map show [2..]) \\ dir)++    putStrLn "% The Shake demo uses an empty directory, OK to use:"+    putStrLn $ "%     " ++ dir+    b <- yesNo auto+    require b "% Please create an empty directory to run the demo from, then run 'shake --demo' again."++    putStr "% Copying files... "+    copyManualData dir+    unless isWindows $ do+         p <- getPermissions $ dir </> "build.sh"+         setPermissions (dir </> "build.sh") p{executable=True}+    putStrLn "done"++    let pause = do+            putStr "% Press ENTER to continue: "+            if auto then putLine "" else getLine+    let execute x = do+            putStrLn $ "% RUNNING: " ++ x+            cmd (Cwd dir) (AddPath [] (maybeToList gccPath)) Shell x :: IO ()+    let build = if isWindows then "build" else "./build.sh"++    putStrLn "\n% [1/5] Building an example project with Shake."+    pause+    putStrLn $ "% RUNNING: cd " ++ dir+    execute build++    putStrLn "\n% [2/5] Running the produced example."+    pause+    execute $ "_build" </> "run" <.> exe++    putStrLn "\n% [3/5] Rebuilding an example project with Shake (nothing should change)."+    pause+    execute build++    putStrLn "\n% [4/5] Cleaning the build."+    pause+    execute $ build ++ " clean"++    putStrLn "\n% [5/5] Rebuilding with 2 threads and profiling."+    pause+    execute $ build ++ " -j2 --report --report=-"+    putStrLn "\n% See the profiling summary above, or look at the HTML profile report in"+    putStrLn $ "%     " ++ dir </> "report.html"++    putStrLn "\n% Demo complete - all the examples can be run from:"+    putStrLn $ "%     " ++ dir+    putStrLn "% For more info see https://shakebuild.com"+    when (isJust ninja) $ do+        putStrLn "\n% PS. Shake can also execute Ninja build files"+        putStrLn "% For more info see https://shakebuild.com/ninja"++++-- | Require the user to press @y@ before continuing.+yesNo :: Bool -> IO Bool+yesNo auto = do+    putStr "% [Y/N] (then ENTER): "+    x <- if auto then putLine "y" else lower <$> getLine+    if "y" `isPrefixOf` x then+        pure True+     else if "n" `isPrefixOf` x then+        pure False+     else+        yesNo auto++putLine :: String -> IO String+putLine x = putStrLn x >> pure x+++-- | Replace exceptions with 'False'.+wrap :: IO Bool -> IO Bool+wrap act = act `catch_` const (pure False)+++-- | Require a condition to be true, or exit with a message.+require :: Bool -> String -> IO ()+require b msg = unless b $ putStrLn msg >> exitFailure
+ src/Development/Shake/Internal/Derived.hs view
@@ -0,0 +1,303 @@+{-# LANGUAGE ScopedTypeVariables #-}++module Development.Shake.Internal.Derived(+    copyFile', copyFileChanged,+    readFile', readFileLines,+    writeFile', writeFileLines, writeFileChanged,+    withTempFile, withTempDir,+    withTempFileWithin, withTempDirWithin,+    getHashedShakeVersion,+    getShakeExtra, getShakeExtraRules, addShakeExtra,+    par, forP,+    newResource, newThrottle, withResources,+    newCache+    ) where++import Control.Monad.Extra+import Control.Monad.IO.Class+import System.Directory+import System.FilePath (takeDirectory)+import System.IO (IOMode (..), hGetContents, withFile)+import qualified System.IO.Extra as IO++import Development.Shake.Internal.Errors+import Development.Shake.Internal.Resource+import Development.Shake.Internal.Core.Types+import Development.Shake.Internal.Core.Action+import Development.Shake.Internal.Core.Rules+import Development.Shake.Internal.Options+import Development.Shake.Internal.Rules.File+import qualified Data.ByteString as BS+import qualified Data.HashMap.Strict as Map+import General.Extra+import Data.List.Extra+import Data.Hashable+import Data.Typeable+import Data.Dynamic+++-- | Get a checksum of a list of files, suitable for using as `shakeVersion`.+--   This will trigger a rebuild when the Shake rules defined in any of the files are changed.+--   For example:+--+-- @+-- main = do+--     ver <- 'getHashedShakeVersion' [\"Shakefile.hs\"]+--     'shakeArgs' 'shakeOptions'{'shakeVersion' = ver} ...+-- @+--+--   To automatically detect the name of the current file, turn on the @TemplateHaskell@+--   extension and write @$(LitE . StringL . loc_filename \<$\> location)@.+--+--   This feature can be turned off during development by passing+--   the flag @--no-rule-version@ or setting 'shakeVersionIgnore' to 'True'.+getHashedShakeVersion :: [FilePath] -> IO String+getHashedShakeVersion files = do+    hashes <- mapM (fmap (hashWithSalt 0) . BS.readFile) files+    pure $ "hash-" ++ show (hashWithSalt 0 hashes)+++-- | Get an item from 'shakeExtra', using the requested type as the key. Fails+-- if the value found at this key does not match the requested type.+getShakeExtra :: Typeable a => Action (Maybe a)+getShakeExtra = liftIO . lookupShakeExtra . shakeExtra =<< getShakeOptions++-- | A version of 'getShakeExtra' in 'Rules'.+getShakeExtraRules :: Typeable a => Rules (Maybe a)+getShakeExtraRules = liftIO . lookupShakeExtra . shakeExtra =<< getShakeOptionsRules++lookupShakeExtra :: forall a . Typeable a => Map.HashMap TypeRep Dynamic -> IO (Maybe a)+lookupShakeExtra mp =+    case Map.lookup want mp of+        Just dyn+            | Just x <- fromDynamic dyn -> pure $ Just x+            | otherwise -> throwM $ errorStructured+                "shakeExtra value is malformed, all keys and values must agree"+                [("Key", Just $ show want)+                ,("Value", Just $ show $ dynTypeRep dyn)]+                "Use addShakeExtra to ensure shakeExtra is well-formed"+        Nothing -> pure Nothing+    where want = typeRep (Proxy :: Proxy a)++-- | Add a properly structued value to 'shakeExtra' which can be retrieved with 'getShakeExtra'.+addShakeExtra :: Typeable a => a -> Map.HashMap TypeRep Dynamic -> Map.HashMap TypeRep Dynamic+addShakeExtra x = Map.insert (typeOf x) (toDyn x)+++-- | @copyFile' old new@ copies the existing file from @old@ to @new@.+--   The @old@ file will be tracked as a dependency.+--   Also creates the new directory if necessary.+copyFile' :: Partial => FilePath -> FilePath -> Action ()+copyFile' old new = do+    need [old]+    putVerbose $ "Copying from " ++ old ++ " to " ++ new+    liftIO $ do+        createDirectoryRecursive $ takeDirectory new+        removeFile_ new -- symlink safety+        copyFile old new++-- | @copyFileChanged old new@ copies the existing file from @old@ to @new@, if the contents have changed.+--   The @old@ file will be tracked as a dependency.+--   Also creates the new directory if necessary.+copyFileChanged :: Partial => FilePath -> FilePath -> Action ()+copyFileChanged old new = do+    need [old]+    -- in newer versions of the directory package we can use copyFileWithMetadata which (we think) updates+    -- the timestamp as well and thus no need to read the source file twice.+    unlessM (liftIO $ doesFileExist new &&^ IO.fileEq old new) $ do+        putVerbose $ "Copying from " ++ old ++ " to " ++ new+        liftIO $ do+            createDirectoryRecursive $ takeDirectory new+            -- copyFile does a lot of clever stuff with permissions etc, so make sure we just reuse it+            removeFile_ new -- symlink safety+            liftIO $ copyFile old new+++-- | Read a file, after calling 'need'. The argument file will be tracked as a dependency.+readFile' :: Partial => FilePath -> Action String+readFile' x = need [x] >> liftIO (readFile x)++-- | Write a file, lifted to the 'Action' monad.+writeFile' :: (MonadIO m, Partial) => FilePath -> String -> m ()+writeFile' name x = liftIO $ do+    createDirectoryRecursive $ takeDirectory name+    removeFile_ name -- symlink safety+    writeFile name x+++-- | A version of 'readFile'' which also splits the result into lines.+--   The argument file will be tracked as a dependency.+readFileLines :: Partial => FilePath -> Action [String]+readFileLines = fmap lines . readFile'++-- | A version of 'writeFile'' which writes out a list of lines.+writeFileLines :: (MonadIO m, Partial) => FilePath -> [String] -> m ()+writeFileLines name = writeFile' name . unlines+++-- | Write a file, but only if the contents would change.+writeFileChanged :: (MonadIO m, Partial) => FilePath -> String -> m ()+writeFileChanged name x = liftIO $ do+    createDirectoryRecursive $ takeDirectory name+    b <- doesFileExist name+    if not b then writeFile name x else do+        -- Cannot use ByteString here, since it has different line handling+        -- semantics on Windows+        b <- withFile name ReadMode $ \h -> do+            src <- hGetContents h+            pure $! src /= x+        when b $ do+            removeFile_ name -- symlink safety+            writeFile name x+++-- | Create a temporary file in the temporary directory. The file will be deleted+--   after the action completes (provided the file is not still open).+--   The 'FilePath' will not have any file extension, will exist, and will be zero bytes long.+--   If you require a file with a specific name, use 'withTempDir'.+withTempFile :: (FilePath -> Action a) -> Action a+withTempFile act = do+    (file, del) <- liftIO IO.newTempFile+    act file `actionFinally` del++-- | Like 'withTempFile' but using a custom temporary directory.+withTempFileWithin :: FilePath -> (FilePath -> Action a) -> Action a+withTempFileWithin tdir act = do+    (file, del) <- liftIO $ IO.newTempFileWithin tdir+    act file `actionFinally` del+++-- | Create a temporary directory inside the system temporary directory.+--   The directory will be deleted after the action completes. As an example:+--+-- @+-- 'withTempDir' $ \\mydir -> do+--    'putInfo' $ \"Temp directory is \" ++ mydir+--    'writeFile'' (mydir \</\> \"test.txt\") \"writing out a temp file\"+-- @+withTempDir :: (FilePath -> Action a) -> Action a+withTempDir act = do+    (dir,del) <- liftIO IO.newTempDir+    act dir `actionFinally` del++-- | Like 'withTempDir' but using a custom temporary directory.+withTempDirWithin :: FilePath -> (FilePath -> Action a) -> Action a+withTempDirWithin tdir act = do+    (dir,del) <- liftIO $ IO.newTempDirWithin tdir+    act dir `actionFinally` del++++-- | A 'parallel' version of 'forM'.+forP :: [a] -> (a -> Action b) -> Action [b]+forP xs f = parallel $ map f xs++-- | Execute two operations in parallel, based on 'parallel'.+par :: Action a -> Action b -> Action (a,b)+par a b = (\[Left a, Right b] -> (a,b)) <$> parallel [Left <$> a, Right <$> b]+++-- | Create a finite resource, given a name (for error messages) and a quantity of the resource that exists.+--   Shake will ensure that actions using the same finite resource do not execute in parallel.+--   As an example, only one set of calls to the Excel API can occur at one time, therefore+--   Excel is a finite resource of quantity 1. You can write:+--+-- @+-- 'Development.Shake.shake' 'Development.Shake.shakeOptions'{'Development.Shake.shakeThreads'=2} $ do+--    'Development.Shake.want' [\"a.xls\",\"b.xls\"]+--    excel <- 'Development.Shake.newResource' \"Excel\" 1+--    \"*.xls\" 'Development.Shake.%>' \\out ->+--        'Development.Shake.withResource' excel 1 $+--            'Development.Shake.cmd' \"excel\" out ...+-- @+--+--   Now the two calls to @excel@ will not happen in parallel.+--+--   As another example, calls to compilers are usually CPU bound but calls to linkers are usually+--   disk bound. Running 8 linkers will often cause an 8 CPU system to grid to a halt. We can limit+--   ourselves to 4 linkers with:+--+-- @+-- disk <- 'Development.Shake.newResource' \"Disk\" 4+-- 'Development.Shake.want' [show i 'Development.Shake.FilePath.<.>' \"exe\" | i <- [1..100]]+-- \"*.exe\" 'Development.Shake.%>' \\out ->+--     'Development.Shake.withResource' disk 1 $+--         'Development.Shake.cmd' \"ld -o\" [out] ...+-- \"*.o\" 'Development.Shake.%>' \\out ->+--     'Development.Shake.cmd' \"cl -o\" [out] ...+-- @+newResource :: String -> Int -> Rules Resource+newResource name mx = liftIO $ newResourceIO name mx+++-- | Create a throttled resource, given a name (for error messages) and a number of resources (the 'Int') that can be+--   used per time period (the 'Double' in seconds). Shake will ensure that actions using the same throttled resource+--   do not exceed the limits. As an example, let us assume that making more than 1 request every 5 seconds to+--   Google results in our client being blacklisted, we can write:+--+-- @+-- google <- 'Development.Shake.newThrottle' \"Google\" 1 5+-- \"*.url\" 'Development.Shake.%>' \\out -> do+--     'Development.Shake.withResource' google 1 $+--         'Development.Shake.cmd' \"wget\" [\"https:\/\/google.com?q=\" ++ 'Development.Shake.FilePath.takeBaseName' out] \"-O\" [out]+-- @+--+--   Now we will wait at least 5 seconds after querying Google before performing another query. If Google change the rules to+--   allow 12 requests per minute we can instead use @'Development.Shake.newThrottle' \"Google\" 12 60@, which would allow+--   greater parallelisation, and avoid throttling entirely if only a small number of requests are necessary.+--+--   In the original example we never make a fresh request until 5 seconds after the previous request has /completed/. If we instead+--   want to throttle requests since the previous request /started/ we can write:+--+-- @+-- google <- 'Development.Shake.newThrottle' \"Google\" 1 5+-- \"*.url\" 'Development.Shake.%>' \\out -> do+--     'Development.Shake.withResource' google 1 $ pure ()+--     'Development.Shake.cmd' \"wget\" [\"https:\/\/google.com?q=\" ++ 'Development.Shake.FilePath.takeBaseName' out] \"-O\" [out]+-- @+--+--   However, the rule may not continue running immediately after 'Development.Shake.withResource' completes, so while+--   we will never exceed an average of 1 request every 5 seconds, we may end up running an unbounded number of+--   requests simultaneously. If this limitation causes a problem in practice it can be fixed.+newThrottle :: String -> Int -> Double -> Rules Resource+newThrottle name count period = liftIO $ newThrottleIO name count period+++-- | Run an action which uses part of several finite resources. Acquires the resources in a stable+--   order, to prevent deadlock. If all rules requiring more than one resource acquire those+--   resources with a single call to 'withResources', resources will not deadlock.+withResources :: [(Resource, Int)] -> Action a -> Action a+withResources res act+    | (r,i):_ <- filter ((< 0) . snd) res = error $ "You cannot acquire a negative quantity of " ++ show r ++ ", requested " ++ show i+    | otherwise = f $ groupSort res+    where+        f [] = act+        f ((r,xs):rs) = withResource r (sum xs) $ f rs+++-- | Given an action on a key, produce a cached version that will execute the action at most once per key per run.+--   Using the cached result will still result include any dependencies that the action requires - e.g. if the action+--   does 'need' then those dependencies will be added to every rule that uses that cache.+--   Each call to 'newCache' creates a separate cache that is independent of all other calls to 'newCache'.+--+--   The operations will not be cached between runs and nothing will be persisted to the Shake database.+--   For an alternative that does persist the cache, see 'Development.Shake.addOracleCache'.+--+--   This function is useful when creating files that store intermediate values,+--   to avoid the overhead of repeatedly reading from disk, particularly if the file requires expensive parsing.+--   As an example:+--+-- @+-- digits \<- 'newCache' $ \\file -> do+--     src \<- readFile\' file+--     pure $ length $ filter isDigit src+-- \"*.digits\" 'Development.Shake.%>' \\x -> do+--     v1 \<- digits ('dropExtension' x)+--     v2 \<- digits ('dropExtension' x)+--     'Development.Shake.writeFile'' x $ show (v1,v2)+-- @+--+--   To create the result @MyFile.txt.digits@ the file @MyFile.txt@ will be read and counted, but only at most+--   once per execution.+newCache :: (Eq k, Hashable k) => (k -> Action v) -> Rules (k -> Action v)+newCache = liftIO . newCacheIO
+ src/Development/Shake/Internal/Errors.hs view
@@ -0,0 +1,143 @@+{-# LANGUAGE DeriveDataTypeable, PatternGuards, RecordWildCards, ConstraintKinds #-}++-- | Errors seen by the user+module Development.Shake.Internal.Errors(+    ShakeException(..),+    throwM, throwImpure,+    errorInternal,+    errorStructured,+    errorNoRuleToBuildType, errorRuleDefinedMultipleTimes,+    errorMultipleRulesMatch, errorRuleRecursion, errorComplexRecursion, errorNoApply,+    errorDirectoryNotFile, errorNoHash+    ) where++import Data.Tuple.Extra+import Control.Exception.Extra+import Control.Monad.IO.Class+import General.Extra+import Data.Typeable+import Data.List.Extra+import Data.Maybe+++throwM :: MonadIO m => SomeException -> m a+throwM = liftIO . throwIO++throwImpure :: SomeException -> a+throwImpure = throw+++errorInternal :: Partial => String -> SomeException+errorInternal msg = toException $ ErrorCall $ unlines $+    ("Development.Shake: Internal error, please report to Neil Mitchell (" ++ msg ++ ")") : callStackFull++alternatives = let (*) = (,) in+    ["_rule_" * "oracle"+    ,"_Rule_" * "Oracle"+    ,"_key_" * "question"+    ,"_Key_" * "Question"+    ,"_result_" * "answer"+    ,"_Result_" * "Answer"+    ,"_addBuiltinRule_" * "addOracle"+    ,"_apply_" * "askOracle"]+++errorStructured :: String -> [(String, Maybe String)] -> String -> SomeException+errorStructured msg args hint = toException $ ErrorCall $ unlines $+        [msg ++ (if null args then "." else ":")] +++        ["  " ++ a ++ [':' | a /= ""] ++ replicate (as - length a + 2) ' ' ++ b | (a,b) <- args2] +++        [hint | hint /= ""]+    where+        as = maximum $ 0 : map (length . fst) args2+        args2 = [(a,b) | (a,Just b) <- args]++++structured :: Bool -> String -> [(String, Maybe String)] -> String -> SomeException+structured alt msg args hint = errorStructured (f msg) (map (first f) args) (f hint)+    where+        f = filter (/= '_') . (if alt then g else id)+        g xs | res:_ <- [to ++ g rest | (from, to) <- alternatives, Just rest <- [stripPrefix from xs]] = res+        g (x:xs) = x : g xs+        g [] = []+++errorDirectoryNotFile :: FilePath -> SomeException+errorDirectoryNotFile dir = errorStructured+    "Build system error - expected a file, got a directory"+    [("Directory", Just dir)]+    "Probably due to calling 'need' on a directory. Shake only permits 'need' on files."++errorNoRuleToBuildType :: TypeRep -> Maybe String -> Maybe TypeRep -> SomeException+errorNoRuleToBuildType tk k tv = structured (specialIsOracleKey tk)+    "Build system error - no _rule_ matches the _key_ type"+    [("_Key_ type", Just $ show tk)+    ,("_Key_ value", k)+    ,("_Result_ type", fmap show tv)]+    "You are missing a call to _addBuiltinRule_, or your call to _apply_ has the wrong _key_ type"++errorRuleDefinedMultipleTimes :: TypeRep -> [String] -> SomeException+errorRuleDefinedMultipleTimes tk locations = structured (specialIsOracleKey tk)+    "Build system error - _rule_ defined twice at one _key_ type"+    (("_Key_ type", Just $ show tk) :+     [("Location " ++ show i, Just x) | (i, x) <- zipFrom 1 locations])+    "You have called _addBuiltinRule_ more than once on the same key type"++errorMultipleRulesMatch :: TypeRep -> String -> [Maybe String] -> SomeException+errorMultipleRulesMatch tk k names = errorStructured+    ("Build system error - key matches " ++ (if null names then "no" else "multiple") ++ " rules")+    ([("Key type",Just $ show tk)+    ,("Key value",Just k)+    ,("Rules matched",Just $ show $ length names)] +++    [("Rule " ++ show i, x) | any isJust names, (i, x) <- zipFrom 1 names])+    (if null names then "Either add a rule that produces the above key, or stop requiring the above key"+    else "Modify your rules so only one can produce the above key")++errorNoHash :: SomeException+errorNoHash = errorStructured "Cannot use shakeChange=ChangeModTime with shakeShare" [] ""++errorRuleRecursion :: TypeRep -> String -> SomeException+-- may involve both rules and oracle, so report as only rules+errorRuleRecursion tk k = errorStructured+    "Build system error - recursion detected"+    [("Key type",Just $ show tk)+    ,("Key value",Just k)]+    "Rules may not be recursive"++errorComplexRecursion :: [String] -> SomeException+errorComplexRecursion ks = errorStructured+    "Build system error - indirect recursion detected"+    [("Key value " ++ show i, Just k) | (i, k) <- zipFrom 1 ks]+    "Rules may not be recursive"++errorNoApply :: TypeRep -> Maybe String -> String -> SomeException+errorNoApply tk k msg = errorStructured+    "Build system error - cannot currently introduce a dependency (e.g. calling 'apply')"+    [("Reason", Just msg)+    ,("Key type", Just $ show tk)+    ,("Key value", k)]+    "Move the call earlier/later"+++-- Should be in Special, but then we get an import cycle+specialIsOracleKey :: TypeRep -> Bool+specialIsOracleKey t = con == "OracleQ"+    where con = show $ fst $ splitTyConApp t+++-- | Error representing all expected exceptions thrown by Shake.+--   Problems when executing rules will be raising using this exception type.+data ShakeException = ShakeException+    {shakeExceptionTarget :: String -- ^ The target that was being built when the exception occurred.+    ,shakeExceptionStack :: [String]  -- ^ A description of the call stack, one entry per line.+    ,shakeExceptionInner :: SomeException -- ^ The underlying exception that was raised.+    }+    deriving Typeable++instance Exception ShakeException++instance Show ShakeException where+    show ShakeException{..} = unlines $+        "Error when running Shake build system:" :+        shakeExceptionStack +++        [displayException shakeExceptionInner]
+ src/Development/Shake/Internal/FileInfo.hs view
@@ -0,0 +1,194 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable, CPP, ForeignFunctionInterface #-}++module Development.Shake.Internal.FileInfo(+    noFileHash, isNoFileHash,+    FileSize, ModTime, FileHash,+    getFileHash, getFileInfo+    ) where++#ifndef MIN_VERSION_unix+#define MIN_VERSION_unix(a,b,c) 0+#endif++#ifndef MIN_VERSION_time+#define MIN_VERSION_time(a,b,c) 0+#endif+++import Data.Hashable+import Control.Exception.Extra+import Development.Shake.Classes+import Development.Shake.Internal.FileName+import qualified Data.ByteString.Lazy.Internal as LBS (defaultChunkSize)+import Data.List.Extra+import Data.Word+import Numeric+import System.IO+import Foreign++#if defined(PORTABLE)+import System.IO.Error+import System.Directory+import Data.Time++#elif defined(mingw32_HOST_OS)+import Development.Shake.Internal.Errors+import Control.Monad+import qualified Data.ByteString.Char8 as BS+import Foreign.C.String+import Data.Char++#else++#if MIN_VERSION_time(1,9,1)+import Data.Time.Clock+import Data.Fixed+#endif++import Development.Shake.Internal.Errors+import GHC.IO.Exception+import System.IO.Error+import System.Posix.Files.ByteString+#endif++-- A piece of file information, where 0 and 1 are special (see fileInfo* functions)+newtype FileInfo a = FileInfo Word32+    deriving (Typeable,Hashable,Binary,Storable,NFData)++noFileHash :: FileHash+noFileHash = FileInfo 1   -- Equal to nothing++isNoFileHash :: FileHash -> Bool+isNoFileHash (FileInfo i) = i == 1++fileInfo :: Word32 -> FileInfo a+fileInfo a = FileInfo $ if a > maxBound - 2 then a else a + 2++instance Show (FileInfo a) where+    show (FileInfo x)+        | x == 0 = "EQ"+        | x == 1 = "NEQ"+        | otherwise = "0x" ++ upper (showHex (x-2) "")++instance Eq (FileInfo a) where+    FileInfo a == FileInfo b+        | a == 0 || b == 0 = True+        | a == 1 || b == 1 = False+        | otherwise = a == b++data FileInfoHash; type FileHash = FileInfo FileInfoHash+data FileInfoMod ; type ModTime  = FileInfo FileInfoMod+data FileInfoSize; type FileSize = FileInfo FileInfoSize+++getFileHash :: FileName -> IO FileHash+getFileHash x = withFile (fileNameToString x) ReadMode $ \h ->+    allocaBytes LBS.defaultChunkSize $ \ptr ->+        go h ptr (hash ())+    where+        go h ptr salt = do+            n <- hGetBufSome h ptr LBS.defaultChunkSize+            if n == 0 then+                pure $! fileInfo $ fromIntegral salt+            else+                go h ptr =<< hashPtrWithSalt ptr n salt++++-- If the result isn't strict then we are referencing a much bigger structure,+-- and it causes a space leak I don't really understand on Linux when running+-- the 'tar' test, followed by the 'benchmark' test.+-- See this blog post: https://neilmitchell.blogspot.co.uk/2015/09/three-space-leaks.html+result :: Word32 -> Word32 -> IO (Maybe (ModTime, FileSize))+result x y = do+    x <- evaluate $ fileInfo x+    y <- evaluate $ fileInfo y+    pure $ Just (x, y)+++-- | True = allow directory, False = disallow+getFileInfo :: Bool -> FileName -> IO (Maybe (ModTime, FileSize))++#if defined(PORTABLE)+-- Portable fallback+getFileInfo allowDir x = handleBool isDoesNotExistError (const $ pure Nothing) $ do+    let file = fileNameToString x+    time <- getModificationTime file+    size <- withFile file ReadMode hFileSize+    result (extractFileTime time) (fromIntegral size)++extractFileTime :: UTCTime -> Word32+extractFileTime = floor . fromRational . toRational . utctDayTime+++#elif defined(mingw32_HOST_OS)+-- Directly against the Win32 API, twice as fast as the portable version+getFileInfo allowDir x = BS.useAsCString (fileNameToByteString x) $ \file ->+    alloca_WIN32_FILE_ATTRIBUTE_DATA $ \fad -> do+        res <- c_GetFileAttributesExA file 0 fad+        let peek = do+                code <- peekFileAttributes fad+                if not allowDir && testBit code 4 then+                    throwIO $ errorDirectoryNotFile $ fileNameToString x+                 else+                    join $ liftM2 result (peekLastWriteTimeLow fad) (peekFileSizeLow fad)+        if res then+            peek+         else if BS.any (>= chr 0x80) (fileNameToByteString x) then withCWString (fileNameToString x) $ \file -> do+            res <- c_GetFileAttributesExW file 0 fad+            if res then peek else pure Nothing+         else+            pure Nothing++#ifdef x86_64_HOST_ARCH+#define CALLCONV ccall+#else+#define CALLCONV stdcall+#endif++foreign import CALLCONV unsafe "Windows.h GetFileAttributesExA" c_GetFileAttributesExA :: CString  -> Int32 -> Ptr WIN32_FILE_ATTRIBUTE_DATA -> IO Bool+foreign import CALLCONV unsafe "Windows.h GetFileAttributesExW" c_GetFileAttributesExW :: CWString -> Int32 -> Ptr WIN32_FILE_ATTRIBUTE_DATA -> IO Bool++data WIN32_FILE_ATTRIBUTE_DATA++alloca_WIN32_FILE_ATTRIBUTE_DATA :: (Ptr WIN32_FILE_ATTRIBUTE_DATA -> IO a) -> IO a+alloca_WIN32_FILE_ATTRIBUTE_DATA act = allocaBytes size_WIN32_FILE_ATTRIBUTE_DATA act+    where size_WIN32_FILE_ATTRIBUTE_DATA = 36++peekFileAttributes :: Ptr WIN32_FILE_ATTRIBUTE_DATA -> IO Word32+peekFileAttributes p = peekByteOff p index_WIN32_FILE_ATTRIBUTE_DATA_dwFileAttributes+    where index_WIN32_FILE_ATTRIBUTE_DATA_dwFileAttributes = 0++peekLastWriteTimeLow :: Ptr WIN32_FILE_ATTRIBUTE_DATA -> IO Word32+peekLastWriteTimeLow p = peekByteOff p index_WIN32_FILE_ATTRIBUTE_DATA_ftLastWriteTime_dwLowDateTime+    where index_WIN32_FILE_ATTRIBUTE_DATA_ftLastWriteTime_dwLowDateTime = 20++peekFileSizeLow :: Ptr WIN32_FILE_ATTRIBUTE_DATA -> IO Word32+peekFileSizeLow p = peekByteOff p index_WIN32_FILE_ATTRIBUTE_DATA_nFileSizeLow+    where index_WIN32_FILE_ATTRIBUTE_DATA_nFileSizeLow = 32+++#else+-- Unix version+getFileInfo allowDir x = handleBool isDoesNotExistError' (const $ pure Nothing) $ do+    s <- getFileStatus $ fileNameToByteString x+    if not allowDir && isDirectory s then+        throwM $ errorDirectoryNotFile $ fileNameToString x+     else+        result (extractFileTime s) (fromIntegral $ fileSize s)+    where+        isDoesNotExistError' e =+            isDoesNotExistError e || ioeGetErrorType e == InappropriateType++extractFileTime :: FileStatus -> Word32+#if MIN_VERSION_unix(2,6,0)+#if MIN_VERSION_time(1,9,1)+extractFileTime = fromInteger . (\(MkFixed x) -> x) . nominalDiffTimeToSeconds . modificationTimeHiRes+#else+extractFileTime x = ceiling $ modificationTimeHiRes x * 1e4+#endif+#else+extractFileTime x = fromIntegral $ fromEnum $ modificationTime x+#endif++#endif
+ src/Development/Shake/Internal/FileName.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances #-}++module Development.Shake.Internal.FileName(+    FileName,+    fileNameFromString, fileNameFromByteString,+    fileNameToString, fileNameToByteString,+    filepathNormalise+    ) where++import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.UTF8 as UTF8+import Development.Shake.Classes+import qualified System.FilePath as Native+import General.Binary+import System.Info.Extra+import Data.List+++---------------------------------------------------------------------+-- FileName newtype++-- | UTF8 ByteString+newtype FileName = FileName BS.ByteString+    deriving (Hashable, Binary, BinaryEx, Eq, NFData)++instance Show FileName where+    show = fileNameToString++instance BinaryEx [FileName] where+    putEx = putEx . map (\(FileName x) -> x)+    getEx = map FileName . getEx++fileNameToString :: FileName -> FilePath+fileNameToString = UTF8.toString . fileNameToByteString++fileNameToByteString :: FileName -> BS.ByteString+fileNameToByteString (FileName x) = x++fileNameFromString :: FilePath -> FileName+fileNameFromString = fileNameFromByteString . UTF8.fromString++fileNameFromByteString :: BS.ByteString -> FileName+fileNameFromByteString = FileName . filepathNormalise+++---------------------------------------------------------------------+-- NORMALISATION++-- | Equivalent to @toStandard . normaliseEx@ from "Development.Shake.FilePath".+filepathNormalise :: BS.ByteString -> BS.ByteString+filepathNormalise xs+    | isWindows, Just (a,xs) <- BS.uncons xs, sep a, Just (b,_) <- BS.uncons xs, sep b = '/' `BS.cons` f xs+    | otherwise = f xs+    where+        sep = Native.isPathSeparator+        f o = deslash o $ BS.concat $ (slash:) $ intersperse slash $ reverse $ (BS.empty:) $ g 0 $ reverse $ split o++        deslash o x+            | x == slash = case (pre,pos) of+                (True,True) -> slash+                (True,False) -> BS.pack "/."+                (False,True) -> BS.pack "./"+                (False,False) -> dot+            | otherwise = (if pre then id else BS.tail) $ (if pos then id else BS.init) x+            where pre = not (BS.null o) && sep (BS.head o)+                  pos = not (BS.null o) && sep (BS.last o)++        g i [] = replicate i dotDot+        g i (x:xs) | BS.null x = g i xs+        g i (x:xs) | x == dotDot = g (i+1) xs+        g i (x:xs) | x == dot = g i xs+        g 0 (x:xs) = x : g 0 xs+        g i (_:xs) = g (i-1) xs -- equivalent to eliminating ../x++        split = BS.splitWith sep++dotDot = BS.pack ".."+dot = BS.singleton '.'+slash = BS.singleton '/'
+ src/Development/Shake/Internal/FilePattern.hs view
@@ -0,0 +1,338 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE PatternGuards, ViewPatterns, TupleSections #-}++module Development.Shake.Internal.FilePattern(+    -- * Primitive API, as exposed+    FilePattern, (?==), (<//>),+    -- * General API, used by other people.+    filePattern,+    -- * Optimisation opportunities+    simple, (?==*),+    -- * Multipattern file rules+    compatible, extract, substitute,+    -- * Accelerated searching+    Walk(..), walk,+    -- * Testing only+    internalTest, isRelativePath, isRelativePattern+    ) where++import Development.Shake.Internal.Errors+import System.FilePath(isPathSeparator)+import Data.List.Extra+import Control.Monad+import Data.Char+import Data.Maybe+import System.Info.Extra+++-- | A type synonym for file patterns, containing @\/\/@ and @*@. For the syntax+--   and semantics of 'FilePattern' see '?=='.+--+--   Most 'normaliseEx'd 'FilePath' values are suitable as 'FilePattern' values which match+--   only that specific file. On Windows @\\@ is treated as equivalent to @\/@.+--+--   You can write 'FilePattern' values as a literal string, or build them+--   up using the operators 'Development.Shake.FilePath.<.>', 'Development.Shake.FilePath.</>'+--   and 'Development.Shake.<//>'. However, beware that:+--+-- * On Windows, use 'Development.Shake.FilePath.<.>' from "Development.Shake.FilePath" instead of from+--   "System.FilePath" - otherwise @\"\/\/*\" \<.\> exe@ results in @\"\/\/*\\\\.exe\"@.+--+-- * If the second argument of 'Development.Shake.FilePath.</>' has a leading path separator (namely @\/@)+--   then the second argument will be returned.+type FilePattern = String++infixr 5 <//>++-- | Join two 'FilePattern' values by inserting two @\/@ characters between them.+--   Will first remove any trailing path separators on the first argument, and any leading+--   separators on the second.+--+-- > "dir" <//> "*" == "dir//*"+(<//>) :: FilePattern -> FilePattern -> FilePattern+a <//> b = dropWhileEnd isPathSeparator a ++ "//" ++ dropWhile isPathSeparator b+++---------------------------------------------------------------------+-- PATTERNS++data Pat = Lit String -- ^ foo+         | Star   -- ^ /*/+         | Skip -- ^ //+         | Skip1 -- ^ //, but must be at least 1 element+         | Stars String [String] String -- ^ *foo*, prefix (fixed), infix floaters, suffix+                                        -- e.g. *foo*bar = Stars "" ["foo"] "bar"+            deriving (Show,Eq,Ord)++fromLit :: Pat -> Maybe String+fromLit (Lit x) = Just x+fromLit _ = Nothing+++data Lexeme = Str String | Slash | SlashSlash++lexer :: FilePattern -> [Lexeme]+lexer "" = []+lexer (x1:x2:xs) | isPathSeparator x1, isPathSeparator x2 = SlashSlash : lexer xs+lexer (x1:xs) | isPathSeparator x1 = Slash : lexer xs+lexer xs = Str a : lexer b+    where (a,b) = break isPathSeparator xs+++-- | Parse a FilePattern. All optimisations I can think of are invalid because they change the extracted expressions.+parse :: FilePattern -> [Pat]+parse = f False True . lexer+    where+        -- str = I have ever seen a Str go past (equivalent to "can I be satisfied by no paths")+        -- slash = I am either at the start, or my previous character was Slash+        f str slash = \case+            [] -> [Lit "" | slash]+            Str "**":xs -> Skip : f True False xs+            Str x:xs -> parseLit x : f True False xs+            SlashSlash:Slash:xs | not str -> Skip1 : f str True xs+            SlashSlash:xs -> Skip : f str False xs+            Slash:xs -> [Lit "" | not str] ++ f str True xs+++parseLit :: String -> Pat+parseLit "*" = Star+parseLit x = case split (== '*') x of+    [x] -> Lit x+    pre:xs | Just (mid,post) <- unsnoc xs -> Stars pre mid post+    _ -> Lit ""+++internalTest :: IO ()+internalTest = do+    let x # y =+            let p = parse x+            in when (p /= y) $ fail $ show ("FilePattern.internalTest",x,p,y)+    "" # [Lit ""]+    "x" # [Lit "x"]+    "/" # [Lit "",Lit ""]+    "x/" # [Lit "x",Lit ""]+    "/x" # [Lit "",Lit "x"]+    "x/y" # [Lit "x",Lit "y"]+    "//" # [Skip]+    "**" # [Skip]+    "//x" # [Skip, Lit "x"]+    "**/x" # [Skip, Lit "x"]+    "x//" # [Lit "x", Skip]+    "x/**" # [Lit "x", Skip]+    "x//y" # [Lit "x",Skip, Lit "y"]+    "x/**/y" # [Lit "x",Skip, Lit "y"]+    "///" # [Skip1, Lit ""]+    "**/**" # [Skip,Skip]+    "**/**/" # [Skip, Skip, Lit ""]+    "///x" # [Skip1, Lit "x"]+    "**/x" # [Skip, Lit "x"]+    "x///" # [Lit "x", Skip, Lit ""]+    "x/**/" # [Lit "x", Skip, Lit ""]+    "x///y" # [Lit "x",Skip, Lit "y"]+    "x/**/y" # [Lit "x",Skip, Lit "y"]+    "////" # [Skip, Skip]+    "**/**/**" # [Skip, Skip, Skip]+    "////x" # [Skip, Skip, Lit "x"]+    "x////" # [Lit "x", Skip, Skip]+    "x////y" # [Lit "x",Skip, Skip, Lit "y"]+    "**//x" # [Skip, Skip, Lit "x"]+++-- | Optimisations that may change the matched expressions+optimise :: [Pat] -> [Pat]+optimise (Skip:Skip:xs) = optimise $ Skip:xs+optimise (Skip:Star:xs) = optimise $ Skip1:xs+optimise (Star:Skip:xs) = optimise $ Skip1:xs+optimise (x:xs) = x : optimise xs+optimise [] =[]+++-- | A 'FilePattern' that will only match 'isRelativePath' values.+isRelativePattern :: FilePattern -> Bool+isRelativePattern ('*':'*':xs)+    | [] <- xs = True+    | x:_ <- xs, isPathSeparator x = True+isRelativePattern _ = False++-- | A non-absolute 'FilePath'.+isRelativePath :: FilePath -> Bool+isRelativePath (x:_) | isPathSeparator x = False+isRelativePath (x:':':_) | isWindows, isAlpha x = False+isRelativePath _ = True+++-- | Given a pattern, and a list of path components, return a list of all matches+--   (for each wildcard in order, what the wildcard matched).+match :: [Pat] -> [String] -> [[String]]+match (Skip:xs) (y:ys) = map ("":) (match xs (y:ys)) ++ match (Skip1:xs) (y:ys)+match (Skip1:xs) (y:ys) = [(y++"/"++r):rs | r:rs <- match (Skip:xs) ys]+match (Skip:xs) [] = map ("":) $ match xs []+match (Star:xs) (y:ys) = map (y:) $ match xs ys+match (Lit x:xs) (y:ys) = concat $ [match xs ys | x == y] ++ [match xs (y:ys) | x == "."]+match (x@Stars{}:xs) (y:ys) | Just rs <- matchStars x y = map (rs ++) $ match xs ys+match [] [] = [[]]+match _ _ = []+++matchOne :: Pat -> String -> Bool+matchOne (Lit x) y = x == y+matchOne x@Stars{} y = isJust $ matchStars x y+matchOne Star _ = True+matchOne p _ = throwImpure $ errorInternal $ "unreachablePattern, matchOne " ++ show p+++-- Only return the first (all patterns left-most) valid star matching+matchStars :: Pat -> String -> Maybe [String]+matchStars (Stars pre mid post) x = do+    x <- stripPrefix pre x+    x <- if null post then Just x else stripSuffix post x+    stripInfixes mid x+    where+        stripInfixes [] x = Just [x]+        stripInfixes (m:ms) x = do+            (a,x) <- stripInfix m x+            (a:) <$> stripInfixes ms x+matchStars p _ = throwImpure $ errorInternal $ "unreachablePattern, matchStars " ++ show p++-- | Match a 'FilePattern' against a 'FilePath', There are three special forms:+--+-- * @*@ matches an entire path component, excluding any separators.+--+-- * @\/\/@ matches an arbitrary number of path components, including absolute path+--   prefixes.+--+-- * @**@ as a path component matches an arbitrary number of path components, but not+--   absolute path prefixes.+--   Currently considered experimental.+--+--   Some examples:+--+-- * @test.c@ matches @test.c@ and nothing else.+--+-- * @*.c@ matches all @.c@ files in the current directory, so @file.c@ matches,+--   but @file.h@ and @dir\/file.c@ don't.+--+-- * @\/\/*.c@ matches all @.c@ files anywhere on the filesystem,+--   so @file.c@, @dir\/file.c@, @dir1\/dir2\/file.c@ and @\/path\/to\/file.c@ all match,+--   but @file.h@ and @dir\/file.h@ don't.+--+-- * @dir\/*\/*@ matches all files one level below @dir@, so @dir\/one\/file.c@ and+--   @dir\/two\/file.h@ match, but @file.c@, @one\/dir\/file.c@, @dir\/file.h@+--   and @dir\/one\/two\/file.c@ don't.+--+--   Patterns with constructs such as @foo\/..\/bar@ will never match+--   normalised 'FilePath' values, so are unlikely to be correct.+(?==) :: FilePattern -> FilePath -> Bool+(?==) p = case optimise $ parse p of+    [x] | x == Skip || x == Skip1 -> if rp then isRelativePath else const True+    p -> let f = not . null . match p . split isPathSeparator+         in if rp then (\x -> isRelativePath x && f x) else f+    where rp = isRelativePattern p++(?==*) :: [FilePattern] -> FilePath -> Bool+(?==*) ps = \x -> any ($ x) vs+    where vs = map (?==) ps++-- | Like '?==', but returns 'Nothing' on if there is no match, otherwise 'Just' with the list+--   of fragments matching each wildcard. For example:+--+-- @+-- 'filePattern' \"**\/*.c\" \"test.txt\" == Nothing+-- 'filePattern' \"**\/*.c\" \"foo.c\" == Just [\"",\"foo\"]+-- 'filePattern' \"**\/*.c\" \"bar\/baz\/foo.c\" == Just [\"bar\/baz/\",\"foo\"]+-- @+--+--   Note that the @**@ will often contain a trailing @\/@, and even on Windows any+--   @\\@ separators will be replaced by @\/@.+filePattern :: FilePattern -> FilePath -> Maybe [String]+filePattern p = \x -> if eq x then Just $ ex x else Nothing+    where eq = (?==) p+          ex = extract p++---------------------------------------------------------------------+-- MULTIPATTERN COMPATIBLE SUBSTITUTIONS++specials :: FilePattern -> [Pat]+specials = concatMap f . parse+    where+        f Lit{} = []+        f Star = [Star]+        f Skip = [Skip]+        f Skip1 = [Skip]+        f (Stars _ xs _) = replicate (length xs + 1) Star++-- | Is the pattern free from any * and //.+simple :: FilePattern -> Bool+simple = null . specials++-- | Do they have the same * and // counts in the same order+compatible :: [FilePattern] -> Bool+compatible [] = True+compatible (x:xs) = all ((==) (specials x) . specials) xs++-- | Extract the items that match the wildcards. The pair must match with '?=='.+extract :: FilePattern -> FilePath -> [String]+extract p = let pat = parse p in \x ->+    case match pat (split isPathSeparator x) of+        [] | p ?== x -> throwImpure $ errorInternal $ "extract with " ++ show p ++ " and " ++ show x+           | otherwise -> error $ "Pattern " ++ show p ++ " does not match " ++ x ++ ", when trying to extract the FilePattern matches"+        ms:_ -> ms+++-- | Given the result of 'extract', substitute it back in to a 'compatible' pattern.+--+-- > p '?==' x ==> substitute (extract p x) p == x+substitute :: [String] -> FilePattern -> FilePath+substitute oms oxs = intercalate "/" $ concat $ snd $ mapAccumL f oms (parse oxs)+    where+        f ms (Lit x) = (ms, [x])+        f (m:ms) Star = (ms, [m])+        f (m:ms) Skip = (ms, split m)+        f (m:ms) Skip1 = (ms, split m)+        f ms (Stars pre mid post) = (ms2, [concat $ pre : zipWith (++) ms1 (mid++[post])])+            where (ms1,ms2) = splitAt (length mid + 1) ms+        f _ _ = error $ "Substitution failed into pattern " ++ show oxs ++ " with " ++ show (length oms) ++ " matches, namely " ++ show oms++        split = linesBy (== '/')+++---------------------------------------------------------------------+-- EFFICIENT PATH WALKING++-- | Given a list of files, return a list of things I can match in this directory+--   plus a list of subdirectories and walks that apply to them.+--   Use WalkTo when the list can be predicted in advance+data Walk = Walk ([String] -> ([String],[(String,Walk)]))+          | WalkTo            ([String],[(String,Walk)])++walk :: [FilePattern] -> (Bool, Walk)+walk ps = (any (\p -> isEmpty p || not (null $ match p [""])) ps2, f ps2)+    where+        ps2 = map (filter (/= Lit ".") . optimise . parse) ps++        f (nubOrd -> ps)+            | Just fin <- mapM fromLit fin+            , Just nxt <- mapM (\(a,b) -> (,f b) <$> fromLit a) nxt+            = WalkTo (fin, nxt)+            | otherwise = Walk $ \xs ->+                (if finStar then xs else filter (\x -> any (`matchOne` x) fin) xs+                ,[(x, f ys) | x <- xs, let ys = concat [b | (a,b) <- nxt, matchOne a x], not $ null ys])+            where+                finStar = Star `elem` fin+                fin = nubOrd $ mapMaybe final ps+                nxt = groupSort $ concatMap next ps+++next :: [Pat] -> [(Pat, [Pat])]+next (Skip1:xs) = [(Star,Skip:xs)]+next (Skip:xs) = (Star,Skip:xs) : next xs+next (x:xs) = [(x,xs) | not $ null xs]+next [] = []++final :: [Pat] -> Maybe Pat+final (Skip:xs) = if isEmpty xs then Just Star else final xs+final (Skip1:xs) = if isEmpty xs then Just Star else Nothing+final (x:xs) = if isEmpty xs then Just x else Nothing+final [] = Nothing++isEmpty = all (== Skip)
+ src/Development/Shake/Internal/History/Bloom.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE ViewPatterns #-}++-- | The endpoints on the cloud server+module Development.Shake.Internal.History.Bloom(+    Bloom, bloomTest, bloomCreate+    ) where++import Data.Word+import Data.Bits+import Data.Hashable+import Data.Semigroup+import Foreign.Storable+import Foreign.Ptr+import Prelude+++-- | Given an Int hash we store+data Bloom a = Bloom+    {-# UNPACK #-} !Word64+    {-# UNPACK #-} !Word64+    {-# UNPACK #-} !Word64+    {-# UNPACK #-} !Word64+    deriving (Eq,Show)++instance Storable (Bloom a) where+    sizeOf _ = 4 * sizeOf (0 :: Word64)+    alignment _ = alignment (0 :: Word64)+    peek (castPtr -> ptr) = Bloom <$> peekElemOff ptr 0 <*> peekElemOff ptr 1 <*> peekElemOff ptr 2 <*> peekElemOff ptr 3+    poke (castPtr -> ptr) (Bloom x1 x2 x3 x4) = do+        pokeElemOff ptr 0 x1+        pokeElemOff ptr 1 x2+        pokeElemOff ptr 2 x3+        pokeElemOff ptr 3 x4++instance Semigroup (Bloom a) where+    Bloom x1 x2 x3 x4 <> Bloom y1 y2 y3 y4 =+        Bloom (x1 .|. y1) (x2 .|. y2) (x3 .|. y3) (x4 .|. y4)++instance Monoid (Bloom a) where+    mempty = Bloom 0 0 0 0+    mappend = (<>)++-- Should the cloud need to know about Key's? It only needs to do Eq on them...+-- If you Key has a smart Eq your build tree might be more diverse+-- Have the Id resolved in Server.++bloomTest :: Hashable a => Bloom a -> a -> Bool+bloomTest bloom x = bloomCreate x <> bloom == bloom++bloomCreate :: Hashable a => a -> Bloom a+bloomCreate (fromIntegral . hash -> x) =+    Bloom (f 1) (f 2) (f 3) (f 4)+    where f i = x `xor` rotate x i
+ src/Development/Shake/Internal/History/Cloud.hs view
@@ -0,0 +1,79 @@++-- | The endpoints on the server+module Development.Shake.Internal.History.Cloud(+    Cloud, newCloud, addCloud, lookupCloud+    ) where++import Development.Shake.Internal.Value+import Development.Shake.Internal.Core.Database+import Development.Shake.Internal.History.Types+import Development.Shake.Internal.History.Network+import Development.Shake.Internal.History.Server+import Development.Shake.Internal.History.Bloom+import Control.Concurrent.Extra+import System.Time.Extra+import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.Trans.Maybe+import Control.Monad.Trans.Class+import General.Fence+import qualified Data.HashMap.Strict as Map+import Data.Typeable+import Data.Either.Extra+import General.Binary+import General.Extra+import General.Wait+++type Initial = Map.HashMap Key (Ver, [Key], Bloom [BS_Identity])++data Cloud = Cloud Server (Locked () -> IO ()) (Fence Locked Initial)+++newLaterFence :: (Locked () -> IO ()) -> Seconds -> a -> IO a -> IO (Fence Locked a)+newLaterFence relock maxTime def act = do+    fence <- newFence+    forkFinally (timeout maxTime act) $ \res -> relock $ signalFence fence $ case res of+        Right (Just v) -> v+        _ -> def+    pure fence++laterFence :: MonadIO m => Fence m a -> Wait m a+laterFence fence = do+    res <- liftIO $ testFence fence+    case res of+        Just v -> pure v+        Nothing -> Later $ waitFence fence+++newCloud :: (Locked () -> IO ()) -> Map.HashMap TypeRep (BinaryOp Key) -> Ver -> [(TypeRep, Ver)] -> [String] -> Maybe (IO Cloud)+newCloud relock binop globalVer ruleVer urls = flip fmap (if null urls then Nothing else connect $ last urls) $ \conn -> do+    conn <- conn+    server <- newServer conn binop globalVer+    fence <- newLaterFence relock 10 Map.empty $ do+        xs <- serverAllKeys server ruleVer+        pure $ Map.fromList [(k,(v,ds,test)) | (k,v,ds,test) <- xs]+    pure $ Cloud server relock fence+++addCloud :: Cloud -> Key -> Ver -> Ver -> [[(Key, BS_Identity)]] -> BS_Store -> [FilePath] -> IO ()+addCloud (Cloud server _ _) x1 x2 x3 x4 x5 x6 = void $ forkIO $ serverUpload server x1 x2 x3 x4 x5 x6+++lookupCloud :: Cloud -> (Key -> Wait Locked (Maybe BS_Identity)) -> Key -> Ver -> Ver -> Wait Locked (Maybe (BS_Store, [[Key]], IO ()))+lookupCloud (Cloud server relock initial) ask key builtinVer userVer = runMaybeT $ do+    mp <- lift $ laterFence initial+    Just (ver, deps, bloom)<- pure $ Map.lookup key mp+    unless (ver == userVer) $ fail ""+    Right vs <- lift $ firstLeftWaitUnordered (fmap (maybeToEither ()) . ask) deps+    unless (bloomTest bloom vs) $ fail ""+    fence <- liftIO $ newLaterFence relock 10 mempty $ serverOneKey server key builtinVer userVer $ zip deps vs+    tree <- lift $ laterFence fence+    f [deps] tree+    where+        f :: [[Key]] -> BuildTree Key -> MaybeT (Wait Locked) (BS_Store, [[Key]], IO ())+        f ks (Done store xs) = pure (store, reverse ks, serverDownloadFiles server key xs)+        f ks (Depend deps trees) = do+            Right vs <- lift $ firstLeftWaitUnordered (fmap (maybeToEither ()) . ask) deps+            Just tree<- pure $ lookup vs trees+            f (deps:ks) tree
+ src/Development/Shake/Internal/History/Network.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE CPP #-}++-- | The network operations available+module Development.Shake.Internal.History.Network(+    Conn, connect, post+    ) where++#ifdef NETWORK+import Network.HTTP+import Network.URI+import Data.List+import Data.Maybe+#endif++import qualified Data.ByteString.Lazy as LBS+++newtype Conn = Conn String++connect :: String -> Maybe (IO Conn)+post :: Conn -> String -> LBS.ByteString -> IO LBS.ByteString+++#ifndef NETWORK++connect _ = Nothing+post (Conn _) _ _ = fail "impossible to get here"++#else++connect x = Just $ pure $ Conn $ x ++ ['/' | not $ "/" `isSuffixOf` x]++post (Conn prefix) url send = do+    let request = Request+            {rqURI = parseURI_ $ prefix ++ url+            ,rqMethod = POST+            ,rqHeaders = [Header HdrContentType "application/octet-stream", Header HdrContentLength $ show $ LBS.length send]+            ,rqBody = send}+    response <- simpleHTTP request+    case response of+        Left e -> fail $ "Network.post, failed: " ++ show e+        Right v | rspCode v /= (2,0,0) -> fail $ "Network.post, failed: " ++ show (rspCode v)+                | otherwise -> pure $ rspBody v+++parseURI_ :: String -> URI+parseURI_ x = fromMaybe (error $ "Failed to parse URI, " ++ x) $ parseURI x++#endif
+ src/Development/Shake/Internal/History/Serialise.hs view
@@ -0,0 +1,108 @@+{-# LANGUAGE FlexibleInstances, DeriveTraversable #-}++-- | The endpoints on the cloud server+module Development.Shake.Internal.History.Serialise(+    BuildTree(..),+    WithTypeReps(..), withTypeReps,+    WithKeys(..), withKeys, withIds, withoutKeys,+    SendAllKeys(..), RecvAllKeys(..),+    SendOneKey(..), RecvOneKey(..),+    SendDownloadFiles(..),+    SendUpload(..)+    ) where++import Development.Shake.Internal.History.Bloom+import General.Extra+import General.Binary+import General.Ids+import Data.List.Extra+import Development.Shake.Internal.Value+import Development.Shake.Internal.FileInfo+import Development.Shake.Internal.History.Types+import qualified Data.HashMap.Strict as Map+import Data.Semigroup+import Data.Typeable+import Prelude+++data BuildTree key+    -- invariant: Entries are sorted+    = Depend [key] [([BS_Identity], BuildTree key)]+    | Done BS_Store [(FilePath, FileSize, FileHash)]++instance BinaryEx (BuildTree Int) where+    getEx = undefined+    putEx = undefined++instance Eq key => Semigroup (BuildTree key) where+    Depend ks1 vs1 <> Depend ks2 vs2+        | ks1 == ks2 = Depend ks1 $ mergeBy undefined vs1 vs2+        | otherwise = Depend ks2 vs2 -- this shouldn't happen, so give up+    x@Done{} <> _ = x+    _ <> y@Done{} = y++instance Eq key => Monoid (BuildTree key) where+    mempty = Depend [] []+    mappend = (<>)+++data WithTypeReps a = WithTypeReps [BS_QTypeRep] a++instance BinaryEx a => BinaryEx (WithTypeReps a) where+    putEx = undefined+    getEx = undefined++withTypeReps :: Traversable f => f TypeRep -> WithTypeReps (f Int)+withTypeReps = undefined++data WithKeys a = WithKeys [BS_Key] a++instance BinaryEx a => BinaryEx (WithKeys a) where+    putEx = undefined+    getEx = undefined++withKeys :: Traversable f => f Key -> WithKeys (f Int)+withKeys = undefined++withIds :: Traversable f => (Id -> m Key) -> f Id -> m (WithKeys (f Int))+withIds = undefined++withoutKeys :: Map.HashMap TypeRep (BinaryOp Key) -> WithKeys (f Int) -> f Key+withoutKeys = undefined++data SendAllKeys typ = SendAllKeys Ver [(typ, Ver)]+    deriving (Functor, Foldable, Traversable)++instance BinaryEx (SendAllKeys Int) where+    putEx = undefined+    getEx = undefined++newtype RecvAllKeys key = RecvAllKeys [(key, Ver, [key], Bloom [BS_Identity])]++instance BinaryEx (RecvAllKeys Int) where+    getEx = undefined+    putEx = undefined++data SendOneKey key = SendOneKey Ver key Ver Ver [(key, BS_Identity)]++instance BinaryEx (SendOneKey Int) where+    getEx = undefined+    putEx = undefined++newtype RecvOneKey key = RecvOneKey (BuildTree key)++instance BinaryEx (RecvOneKey Int) where+    getEx = undefined+    putEx = undefined++data SendDownloadFiles key = SendDownloadFiles Ver key Ver Ver [(FilePath, FileSize, FileHash)]++instance BinaryEx (SendDownloadFiles Int) where+    getEx = undefined+    putEx = undefined++data SendUpload key = SendUpload Ver key Ver Ver [[(key, BS_Identity)]] BS_Store [(FilePath, FileSize, FileHash)]++instance BinaryEx (SendUpload Int) where+    getEx = undefined+    putEx = undefined
+ src/Development/Shake/Internal/History/Server.hs view
@@ -0,0 +1,44 @@++-- | The endpoints on the cloud server+module Development.Shake.Internal.History.Server(+    Server, BuildTree(..),+    newServer,+    serverAllKeys, serverOneKey, serverDownloadFiles,+    serverUpload+    ) where++import Development.Shake.Internal.History.Bloom+import Development.Shake.Internal.History.Serialise+import Development.Shake.Internal.Value+import General.Binary+import General.Extra+import qualified Data.HashMap.Strict as Map+import qualified Data.ByteString.Lazy as LBS+import qualified Data.ByteString as BS+import Development.Shake.Internal.FileInfo+import Development.Shake.Internal.History.Types+import Development.Shake.Internal.History.Network+import Data.Typeable+++data Server = Server Conn (Map.HashMap TypeRep (BinaryOp Key)) Ver++newServer :: Conn -> Map.HashMap TypeRep (BinaryOp Key) -> Ver -> IO Server+newServer a b c = pure $ Server a b c++serverAllKeys :: Server -> [(TypeRep, Ver)] -> IO [(Key, Ver, [Key], Bloom [BS_Identity])]+serverAllKeys (Server conn key ver) typs = do+    res <- post conn "allkeys/v1" $ LBS.fromChunks [runBuilder $ putEx $ withTypeReps $ SendAllKeys ver typs]+    let RecvAllKeys ans = withoutKeys key $ getEx $ BS.concat $ LBS.toChunks res+    pure ans++serverOneKey :: Server -> Key -> Ver -> Ver -> [(Key, BS_Identity)] -> IO (BuildTree Key)+serverOneKey _ _ _ _ _ = pure $ Depend [] []+++serverDownloadFiles :: Server -> Key -> [(FilePath, FileSize, FileHash)] -> IO ()+serverDownloadFiles _ _ _ = fail "Failed to download the files"+++serverUpload :: Server -> Key -> Ver -> Ver -> [[(Key, BS_Identity)]] -> BS_Store -> [FilePath] -> IO ()+serverUpload _ key _ _ _ _ _  = print ("SERVER", "Uploading key", key)
+ src/Development/Shake/Internal/History/Shared.hs view
@@ -0,0 +1,198 @@+{-# LANGUAGE RecordWildCards, ScopedTypeVariables, TupleSections #-}++module Development.Shake.Internal.History.Shared(+    Shared, newShared,+    addShared, lookupShared,+    removeShared, listShared,+    sanityShared+    ) where++import Control.Exception+import Development.Shake.Internal.Value+import Development.Shake.Internal.History.Types+import Development.Shake.Internal.History.Symlink+import Development.Shake.Internal.Core.Database+import Development.Shake.Classes+import General.Binary+import General.Extra+import Data.List+import Control.Monad.Extra+import System.Directory.Extra+import System.FilePath+import System.IO.Extra+import Numeric+import Development.Shake.Internal.FileInfo+import General.Wait+import Development.Shake.Internal.FileName+import Data.Monoid+import Control.Monad.IO.Class+import Data.Maybe+import qualified Data.ByteString as BS+import Prelude+++data Shared = Shared+    {globalVersion :: !Ver+    ,keyOp :: BinaryOp Key+    ,sharedRoot :: FilePath+    ,useSymlink :: Bool+    }++newShared :: Bool -> BinaryOp Key -> Ver -> FilePath -> IO Shared+newShared useSymlink keyOp globalVersion sharedRoot = pure Shared{..}+++data Entry = Entry+    {entryKey :: Key+    ,entryGlobalVersion :: !Ver+    ,entryBuiltinVersion :: !Ver+    ,entryUserVersion :: !Ver+    ,entryDepends :: [[(Key, BS_Identity)]]+    ,entryResult :: BS_Store+    ,entryFiles :: [(FilePath, FileHash)]+    } deriving (Show, Eq)++putEntry :: BinaryOp Key -> Entry -> Builder+putEntry binop Entry{..} =+    putExStorable entryGlobalVersion <>+    putExStorable entryBuiltinVersion <>+    putExStorable entryUserVersion <>+    putExN (putOp binop entryKey) <>+    putExN (putExList $ map (putExList . map putDepend) entryDepends) <>+    putExN (putExList $ map putFile entryFiles) <>+    putEx entryResult+    where+        putDepend (a,b) = putExN (putOp binop a) <> putEx b+        putFile (a,b) = putExStorable b <> putEx a++getEntry :: BinaryOp Key -> BS.ByteString -> Entry+getEntry binop x+    | (x1, x2, x3, x) <- binarySplit3 x+    , (x4, x) <- getExN x+    , (x5, x) <- getExN x+    , (x6, x7) <- getExN x+    = Entry+        {entryGlobalVersion = x1+        ,entryBuiltinVersion = x2+        ,entryUserVersion = x3+        ,entryKey = getOp binop x4+        ,entryDepends = map (map getDepend . getExList) $ getExList x5+        ,entryFiles = map getFile $ getExList x6+        ,entryResult = getEx x7+        }+    where+        getDepend x | (a, b) <- getExN x = (getOp binop a, getEx b)+        getFile x | (b, a) <- binarySplit x = (getEx a, b)++hexed x = showHex (abs $ hash x) ""++-- | The path under which everything relating to a Key lives+sharedFileDir :: Shared -> Key -> FilePath+sharedFileDir shared key = sharedRoot shared </> ".shake.cache" </> hexed key++-- | The list of files containing Entry values, given a result of 'sharedFileDir'+sharedFileKeys :: FilePath -> IO [FilePath]+sharedFileKeys dir = do+    b <- doesDirectoryExist_ $ dir </> "_key"+    if not b then pure [] else listFiles $ dir </> "_key"++loadSharedEntry :: Shared -> Key -> Ver -> Ver -> IO [IO (Maybe Entry)]+loadSharedEntry shared@Shared{..} key builtinVersion userVersion =+    map f <$> sharedFileKeys (sharedFileDir shared key)+    where+        f file = do+            e@Entry{..} <- getEntry keyOp <$> BS.readFile file+            let valid = entryKey == key && entryGlobalVersion == globalVersion && entryBuiltinVersion == builtinVersion && entryUserVersion == userVersion+            pure $ if valid then Just e else Nothing+++-- | Given a way to get the identity, see if you can find a stored cloud version+lookupShared :: Shared -> (Key -> Wait Locked (Maybe BS_Identity)) -> Key -> Ver -> Ver -> Wait Locked (Maybe (BS_Store, [[Key]], IO ()))+lookupShared shared ask key builtinVersion userVersion = do+    ents <- liftIO $ loadSharedEntry shared key builtinVersion userVersion+    flip firstJustWaitUnordered ents $ \act -> do+        me <- liftIO act+        case me of+            Nothing -> pure Nothing+            Just Entry{..} -> do+                -- use Nothing to indicate success, Just () to bail out early on mismatch+                let result x = if isJust x then Nothing else Just $ (entryResult, map (map fst) entryDepends, ) $ do+                        let dir = sharedFileDir shared entryKey+                        forM_ entryFiles $ \(file, hash) ->+                            copyFileLink (useSymlink shared) (dir </> show hash) file+                result <$> firstJustM id+                    [ firstJustWaitUnordered id+                        [ test <$> ask k | (k, i1) <- kis+                        , let test = maybe (Just ()) (\i2 -> if i1 == i2 then Nothing else Just ())]+                    | kis <- entryDepends]+++saveSharedEntry :: Shared -> Entry -> IO ()+saveSharedEntry shared entry = do+    let dir = sharedFileDir shared (entryKey entry)+    createDirectoryRecursive dir+    forM_ (entryFiles entry) $ \(file, hash) ->+        unlessM (doesFileExist_ $ dir </> show hash) $+            copyFileLink (useSymlink shared) file (dir </> show hash)+    -- Write key after files to make sure cache is always useable+    let v = runBuilder $ putEntry (keyOp shared) entry+    let dirName = dir </> "_key"+    createDirectoryRecursive dirName+    -- #757, make sure we write this file atomically+    (tempFile, cleanUp) <- newTempFileWithin dir+    (BS.writeFile tempFile v >> renameFile tempFile (dirName </> hexed v)) `onException` cleanUp+++addShared :: Shared -> Key -> Ver -> Ver -> [[(Key, BS_Identity)]] -> BS_Store -> [FilePath] -> IO ()+addShared shared entryKey entryBuiltinVersion entryUserVersion entryDepends entryResult files = do+    files <- mapM (\x -> (x,) <$> getFileHash (fileNameFromString x)) files+    saveSharedEntry shared Entry{entryFiles = files, entryGlobalVersion = globalVersion shared, ..}++removeShared :: Shared -> (Key -> Bool) -> IO ()+removeShared Shared{..} test = do+    dirs <- listDirectories $ sharedRoot </> ".shake.cache"+    deleted <- forM dirs $ \dir -> do+        files <- sharedFileKeys dir+        -- if any key matches, clean them all out+        b <- flip anyM files $ \file -> handleSynchronous (\e -> putStrLn ("Warning: " ++ show e) >> pure False) $+            evaluate . test . entryKey . getEntry keyOp =<< BS.readFile file+        when b $ removePathForcibly dir+        pure b+    liftIO $ putStrLn $ "Deleted " ++ show (length (filter id deleted)) ++ " entries"++listShared :: Shared -> IO ()+listShared Shared{..} = do+    dirs <- listDirectories $ sharedRoot </> ".shake.cache"+    forM_ dirs $ \dir -> do+        putStrLn $ "Directory: " ++ dir+        keys <- sharedFileKeys dir+        forM_ keys $ \key ->+            handleSynchronous (\e -> putStrLn $ "Warning: " ++ show e) $ do+                Entry{..} <- getEntry keyOp <$> BS.readFile key+                putStrLn $ "  Key: " ++ show entryKey+                forM_ entryFiles $ \(file,_) ->+                    putStrLn $ "    File: " ++ file++sanityShared :: Shared -> IO ()+sanityShared Shared{..} = do+    dirs <- listDirectories $ sharedRoot </> ".shake.cache"+    forM_ dirs $ \dir -> do+        putStrLn $ "Directory: " ++ dir+        keys <- sharedFileKeys dir+        forM_ keys $ \key ->+            handleSynchronous (\e -> putStrLn $ "Warning: " ++ show e) $ do+                Entry{..} <- getEntry keyOp <$> BS.readFile key+                putStrLn $ "  Key: " ++ show entryKey+                putStrLn $ "  Key file: " ++ key+                forM_ entryFiles $ \(file,hash) ->+                    checkFile file dir hash+    where+      checkFile filename dir keyHash = do+          let cachefile = dir </> show keyHash+          putStrLn $ "    File: " ++ filename+          putStrLn $ "    Cache file: " ++ cachefile+          ifM (not <$> doesFileExist_ cachefile)+              (putStrLn "      Error: cache file does not exist") $+              ifM ((/= keyHash) <$> getFileHash (fileNameFromString cachefile))+                  (putStrLn "      Error: cache file hash does not match stored hash")+                  (putStrLn "      OK")
+ src/Development/Shake/Internal/History/Symlink.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE CPP #-}++module Development.Shake.Internal.History.Symlink(+    copyFileLink,+    createLinkMaybe+    ) where++import Control.Monad.Extra+import General.Extra+import System.Directory+import System.FilePath+++#ifdef mingw32_HOST_OS+import Foreign.Ptr+import Foreign.C.String+#else+import System.Posix.Files(createLink)+#endif++createLinkMaybe :: FilePath -> FilePath -> IO (Maybe String)++#ifdef mingw32_HOST_OS++#ifdef x86_64_HOST_ARCH+#define CALLCONV ccall+#else+#define CALLCONV stdcall+#endif++foreign import CALLCONV unsafe "Windows.h CreateHardLinkW " c_CreateHardLinkW :: CWString -> CWString -> Ptr () -> IO Bool++createLinkMaybe from to = withCWString from $ \cfrom -> withCWString to $ \cto -> do+    res <- c_CreateHardLinkW cto cfrom nullPtr+    pure $ if res then Nothing else Just "CreateHardLink failed."++#else++createLinkMaybe from to = handleIO (pure . Just . show) $ createLink from to >> pure Nothing++#endif+++copyFileLink :: Bool -> FilePath -> FilePath -> IO ()+copyFileLink useSymlink from to = do+    createDirectoryRecursive $ takeDirectory to+    removeFile_ to+    if not useSymlink then copyFile from to else do+        b <- createLinkMaybe from to+        whenJust b $ \_ ->+            copyFile from to+        -- making files read only stops them from inadvertently mutating the cache+        forM_ [from, to] $ \x -> do+            perm <- getPermissions x+            setPermissions x perm{writable=False}
+ src/Development/Shake/Internal/History/Types.hs view
@@ -0,0 +1,11 @@++module Development.Shake.Internal.History.Types(+    BS_QTypeRep, BS_Key, BS_Store, BS_Identity+    ) where++import qualified Data.ByteString as BS++type BS_QTypeRep = BS.ByteString+type BS_Key = BS.ByteString+type BS_Store = BS.ByteString+type BS_Identity = BS.ByteString
+ src/Development/Shake/Internal/Options.hs view
@@ -0,0 +1,342 @@+{-# LANGUAGE DeriveDataTypeable, PatternGuards #-}++-- | Types exposed to the user+module Development.Shake.Internal.Options(+    Progress(..), Verbosity(..), Rebuild(..), Lint(..), Change(..),+    ShakeOptions(..), shakeOptions,+    -- Internal stuff+    shakeRebuildApply, shakeAbbreviationsApply, shakeOptionsFields+    ) where++import Data.Data+import Data.List.Extra+import Data.Tuple.Extra+import Data.Maybe+import Data.Dynamic+import Control.Monad+import General.Extra+import System.Time.Extra+import qualified Data.HashMap.Strict as Map+import Development.Shake.Internal.FilePattern+import Development.Shake.Internal.Errors+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.UTF8 as UTF8+import Development.Shake.Internal.CmdOption+import Data.Semigroup+import Prelude+++-- | The current assumptions made by the build system, used by 'shakeRebuild'. These options+--   allow the end user to specify that any rules run are either to be treated as clean, or as+--   dirty, regardless of what the build system thinks.+--+--   These assumptions only operate on files reached by the current 'Development.Shake.action' commands. Any+--   other files in the database are left unchanged.+data Rebuild+    = RebuildNow+        -- ^ Assume these files are dirty and require rebuilding.+        --   for benchmarking rebuild speed and for rebuilding if untracked dependencies have changed.+        --   This flag is safe, but may cause more rebuilding than necessary.+    | RebuildNormal+        -- ^ Useful to reset the rebuild status to how it was before, equivalent to passing no 'Rebuild' flags.+    | RebuildLater+        -- ^ /This assumption is unsafe, and may lead to incorrect build results in this run/.+        --   Assume these files are clean in this run, but test them normally in future runs.+{-+    | RebuildNever+        -- Add to RebuildNow: Useful to undo the results of 'RebuildNever',+        -- ^ /This assumption is unsafe, and may lead to incorrect build results in this run, and in future runs/.+        --   Assume and record that these files are clean and do not require rebuilding, provided the file+        --   has been built before. Useful if you have modified a file in some+        --   inconsequential way, such as only the comments or whitespace, and wish to avoid a rebuild.+-}+      deriving (Eq,Ord,Show,Read,Typeable,Data,Enum,Bounded)+++-- | Which lint checks to perform, used by 'shakeLint'.+data Lint+    = LintBasic+        -- ^ The most basic form of linting. Checks that the current directory does not change and that results do not change after they+        --   are first written. Any calls to 'needed' will assert that they do not cause a rule to be rebuilt.+    | LintFSATrace+        -- ^ Track which files are accessed by command line programs+        -- using <https://github.com/jacereda/fsatrace fsatrace>.+      deriving (Eq,Ord,Show,Read,Typeable,Data,Enum,Bounded)+++-- | How should you determine if a file has changed, used by 'shakeChange'. The most common values are+--   'ChangeModtime' (the default, very fast, @touch@ causes files to rebuild) and 'ChangeModtimeAndDigestInput'+--   (slightly slower, @touch@ and switching @git@ branches does not cause input files to rebuild).+data Change+    = ChangeModtime+        -- ^ Compare equality of modification timestamps, a file has changed if its last modified time changes.+        --   A @touch@ will force a rebuild. This mode is fast and usually sufficiently accurate, so is the default.+    | ChangeDigest+        -- ^ Compare equality of file contents digests, a file has changed if its digest changes.+        --   A @touch@ will not force a rebuild. Use this mode if modification times on your file system are unreliable.+    | ChangeModtimeAndDigest+        -- ^ A file is rebuilt if both its modification time and digest have changed. For efficiency reasons, the modification+        --   time is checked first, and if that has changed, the digest is checked.+    | ChangeModtimeAndDigestInput+        -- ^ Use 'ChangeModtimeAndDigest' for input\/source files and 'ChangeModtime' for output files.+        --   An input file is one which is a dependency but is not built by Shake as it has no+        --   matching rule and already exists on the file system.+    | ChangeModtimeOrDigest+        -- ^ A file is rebuilt if either its modification time or its digest has changed. A @touch@ will force a rebuild,+        --   but even if a files modification time is reset afterwards, changes will also cause a rebuild.+      deriving (Eq,Ord,Show,Read,Typeable,Data,Enum,Bounded)+++-- | Information about the current state of the build, obtained by either passing a callback function+--   to 'Development.Shake.shakeProgress' (asynchronous output) or 'Development.Shake.getProgress'+--   (synchronous output). Typically a build system will pass 'progressDisplay' to 'Development.Shake.shakeProgress',+--   which will poll this value and produce status messages.+data Progress = Progress+-- In retrospect shakeProgress should have been done differently, as a feature you turn on in Rules+-- but easiest way around that for now is put the Progress type in Options++    {isFailure :: !(Maybe String) -- ^ Starts out 'Nothing', becomes 'Just' a target name if a rule fails.+    ,countSkipped :: {-# UNPACK #-} !Int -- ^ Number of rules which were required, but were already in a valid state.+    ,countBuilt :: {-# UNPACK #-} !Int -- ^ Number of rules which were have been built in this run.+    ,countUnknown :: {-# UNPACK #-} !Int -- ^ Number of rules which have been built previously, but are not yet known to be required.+    ,countTodo :: {-# UNPACK #-} !Int -- ^ Number of rules which are currently required (ignoring dependencies that do not change), but not built.+    ,timeSkipped :: {-# UNPACK #-} !Double -- ^ Time spent building 'countSkipped' rules in previous runs.+    ,timeBuilt :: {-# UNPACK #-} !Double -- ^ Time spent building 'countBuilt' rules.+    ,timeUnknown :: {-# UNPACK #-} !Double -- ^ Time spent building 'countUnknown' rules in previous runs.+    ,timeTodo :: {-# UNPACK #-} !(Double,Int) -- ^ Time spent building 'countTodo' rules in previous runs, plus the number which have no known time (have never been built before).+    }+    deriving (Eq,Ord,Show,Read,Data,Typeable)++instance Semigroup Progress where+    a <> b = Progress+        {isFailure = isFailure a `mplus` isFailure b+        ,countSkipped = countSkipped a + countSkipped b+        ,countBuilt = countBuilt a + countBuilt b+        ,countUnknown = countUnknown a + countUnknown b+        ,countTodo = countTodo a + countTodo b+        ,timeSkipped = timeSkipped a + timeSkipped b+        ,timeBuilt = timeBuilt a + timeBuilt b+        ,timeUnknown = timeUnknown a + timeUnknown b+        ,timeTodo = let (a1,a2) = timeTodo a; (b1,b2) = timeTodo b+                        x1 = a1 + b1; x2 = a2 + b2+                    in x1 `seq` x2 `seq` (x1,x2)+        }++instance Monoid Progress where+    mempty = Progress Nothing 0 0 0 0 0 0 0 (0,0)+    mappend = (<>)+++-- | Options to control the execution of Shake, usually specified by overriding fields in+--   'shakeOptions':+--+--   @ 'shakeOptions'{'shakeThreads'=4, 'shakeReport'=[\"report.html\"]} @+--+--   The 'Data' instance for this type reports the 'shakeProgress' and 'shakeOutput' fields as having the abstract type 'Hidden',+--   because 'Data' cannot be defined for functions or 'TypeRep's.+data ShakeOptions = ShakeOptions+    {shakeFiles :: FilePath+        -- ^ Defaults to @.shake@. The directory used for storing Shake metadata files.+        --   All metadata files will be named @'shakeFiles'\/.shake./file-name/@, for some @/file-name/@.+        --   If the 'shakeFiles' directory does not exist it will be created.+        --   If set to @\"\/dev\/null\"@ then no shakeFiles are read or written (even on Windows).+    ,shakeThreads :: Int+        -- ^ Defaults to @1@. Maximum number of rules to run in parallel, similar to @make --jobs=/N/@.+        --   For many build systems, a number equal to or slightly less than the number of physical processors+        --   works well. Use @0@ to match the detected number of processors (when @0@, 'getShakeOptions' will+        --   return the number of threads used).+    ,shakeVersion :: String+        -- ^ Defaults to @"1"@. The version number of your build rules.+        --   Change the version number to force a complete rebuild, such as when making+        --   significant changes to the rules that require a wipe. The version number should be+        --   set in the source code, and not passed on the command line.+    ,shakeVerbosity :: Verbosity+        -- ^ Defaults to 'Info'. What level of messages should be printed out.+    ,shakeStaunch :: Bool+        -- ^ Defaults to 'False'. Operate in staunch mode, where building continues even after errors,+        --   similar to @make --keep-going@.+    ,shakeReport :: [FilePath]+        -- ^ Defaults to @[]@. Write a profiling report to a file, showing which rules rebuilt,+        --   why, and how much time they took. Useful for improving the speed of your build systems.+        --   If the file extension is @.json@ it will write JSON data; if @.js@ it will write Javascript;+        --   if @.trace@ it will write trace events (load into @about:\/\/tracing@ in Chrome);+        --   otherwise it will write HTML.+    ,shakeLint :: Maybe Lint+        -- ^ Defaults to 'Nothing'. Perform sanity checks during building, see 'Lint' for details.+    ,shakeLintInside :: [FilePath]+        -- ^ Directories in which the files will be tracked by the linter.+    ,shakeLintIgnore :: [FilePattern]+        -- ^ File patterns which are ignored from linter tracking, a bit like calling 'Development.Shake.trackAllow' in every rule.+    ,shakeLintWatch :: [FilePattern]+        -- ^ File patterns whose modification causes an error. Raises an error even if 'shakeLint' is 'Nothing'.+    ,shakeCommandOptions :: [CmdOption]+        -- ^ Defaults to @[]@. Additional options to be passed to all command invocations.+    ,shakeFlush :: Maybe Seconds+        -- ^ Defaults to @'Just' 10@. How often to flush Shake metadata files in seconds, or 'Nothing' to never flush explicitly.+        --   It is possible that on abnormal termination (not Haskell exceptions) any rules that completed in the last+        --   'shakeFlush' seconds will be lost.+    ,shakeRebuild :: [(Rebuild, FilePattern)]+        -- ^ What to rebuild+    ,shakeAbbreviations :: [(String,String)]+        -- ^ Defaults to @[]@. A list of substrings that should be abbreviated in status messages, and their corresponding abbreviation.+        --   Commonly used to replace the long paths (e.g. @.make\/i586-linux-gcc\/output@) with an abbreviation (e.g. @$OUT@).+    ,shakeStorageLog :: Bool+        -- ^ Defaults to 'False'. Write a message to @'shakeFiles'\/.shake.storage.log@ whenever a storage event happens which may impact+        --   on the current stored progress. Examples include database version number changes, database compaction or corrupt files.+    ,shakeLineBuffering :: Bool+        -- ^ Defaults to 'True'. Change 'stdout' and 'stderr' to line buffering while running Shake.+    ,shakeTimings :: Bool+        -- ^ Defaults to 'False'. Print timing information for each stage at the end.+    ,shakeRunCommands :: Bool+        -- ^ Default to 'True'. Should you run command line actions, set to 'False' to skip actions whose output streams and exit code+        --   are not used. Useful for profiling the non-command portion of the build system.+    ,shakeChange :: Change+        -- ^ Default to 'ChangeModtime'. How to check if a file has changed, see 'Change' for details.+    ,shakeCreationCheck :: Bool+        -- ^ Default to 'True'. After running a rule to create a file, is it an error if the file does not exist.+        --   Provided for compatibility with @make@ and @ninja@ (which have ugly file creation semantics).+    ,shakeLiveFiles :: [FilePath]+        -- ^ Default to @[]@. After the build system completes, write a list of all files which were /live/ in that run,+        --   i.e. those which Shake checked were valid or rebuilt. Produces best answers if nothing rebuilds.+    ,shakeVersionIgnore :: Bool+        -- ^ Defaults to 'False'. Ignore any differences in 'shakeVersion'.+    ,shakeColor :: Bool+        -- ^ Defaults to 'False'. Whether to colorize the output.+    ,shakeShare :: Maybe FilePath+        -- ^ Defaults to 'Nothing'. Whether to use and store outputs in a shared directory.+    ,shakeCloud :: [String]+        -- ^ Defaults to @[]@. Cloud servers to talk to forming a shared cache.+    ,shakeSymlink :: Bool+        -- ^ Defaults to @False@. Use symlinks for 'shakeShare' if they are available.+        --   If this setting is @True@ (even if symlinks are not available) then files will be+        --   made read-only to avoid inadvertantly poisoning the shared cache.+        --   Note the links are actually hard links, not symlinks.+    ,shakeNeedDirectory :: Bool+        -- ^ Defaults to @False@. Is depending on a directory an error (default), or it is permitted with+        --   undefined results. Provided for compatibility with @ninja@.+    ,shakeAllowRedefineRules :: Bool+        -- ^ Whether to allow calling addBuiltinRule for the same key more than once+    ,shakeProgress :: IO Progress -> IO ()+        -- ^ Defaults to no action. A function called when the build starts, allowing progress to be reported.+        --   The function is called on a separate thread, and that thread is killed when the build completes.+        --   For applications that want to display progress messages, 'progressSimple' is often sufficient, but more advanced+        --   users should look at the 'Progress' data type.+    ,shakeOutput :: Verbosity -> String -> IO ()+        -- ^ Defaults to writing using 'putStrLn'. A function called to output messages from Shake, along with the 'Verbosity' at+        --   which that message should be printed. This function will be called atomically from all other 'shakeOutput' functions.+        --   The 'Verbosity' will always be greater than or higher than 'shakeVerbosity'.+    ,shakeTrace :: String -> String -> Bool -> IO ()+        -- ^ Defaults to doing nothing.+        --   Called for each call of 'Development.Shake.traced', with the key, the command and 'True' for starting, 'False' for stopping.+    ,shakeExtra :: Map.HashMap TypeRep Dynamic+        -- ^ This a map which can be used to store arbitrary extra information that a user may need when writing rules.+        --   The key of each entry must be the 'dynTypeRep' of the value.+        --   Insert values using 'addShakeExtra' and retrieve them using 'getShakeExtra'.+        --   The correct way to use this field is to define a hidden newtype for the key, so that conflicts cannot occur.+    }+    deriving Typeable++-- | The default set of 'ShakeOptions'.+shakeOptions :: ShakeOptions+shakeOptions = ShakeOptions+    ".shake" 1 "1" Info False [] Nothing [] [] [] [] (Just 10) [] [] False True False+    True ChangeModtime True [] False False Nothing [] False False False+    (const $ pure ())+    (const $ BS.putStrLn . UTF8.fromString) -- try and output atomically using BS+    (\_ _ _ -> pure ())+    Map.empty++fieldsShakeOptions =+    ["shakeFiles", "shakeThreads", "shakeVersion", "shakeVerbosity", "shakeStaunch", "shakeReport"+    ,"shakeLint", "shakeLintInside", "shakeLintIgnore", "shakeLintWatch", "shakeCommandOptions"+    ,"shakeFlush", "shakeRebuild", "shakeAbbreviations", "shakeStorageLog"+    ,"shakeLineBuffering", "shakeTimings", "shakeRunCommands", "shakeChange", "shakeCreationCheck"+    ,"shakeLiveFiles", "shakeVersionIgnore", "shakeColor", "shakeShare", "shakeCloud", "shakeSymlink"+    ,"shakeNeedDirectory", "shakeCanRedefineRules"+    ,"shakeProgress", "shakeOutput", "shakeTrace", "shakeExtra"]+tyShakeOptions = mkDataType "Development.Shake.Types.ShakeOptions" [conShakeOptions]+conShakeOptions = mkConstr tyShakeOptions "ShakeOptions" fieldsShakeOptions Prefix+unhide x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20 x21 x22 x23 x24 x25 x26 x27 x28 y1 y2 y3 y4 =+  ShakeOptions x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20 x21 x22 x23 x24 x25 x26 x27 x28+        (fromHidden y1) (fromHidden y2) (fromHidden y3) (fromHidden y4)++instance Data ShakeOptions where+    gfoldl k z (ShakeOptions x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20 x21 x22 x23 x24 x25 x26 x27 x28 y1 y2 y3 y4) =+        z unhide `k` x1 `k` x2 `k` x3 `k` x4 `k` x5 `k` x6 `k` x7 `k` x8 `k` x9 `k` x10 `k` x11 `k`+        x12 `k` x13 `k` x14 `k` x15 `k` x16 `k` x17 `k` x18 `k` x19 `k` x20 `k` x21 `k` x22 `k` x23 `k` x24 `k` x25 `k` x26 `k` x27 `k` x28 `k`+        Hidden y1 `k` Hidden y2 `k` Hidden y3 `k` Hidden y4+    gunfold k z _ = k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ k $ z unhide+    toConstr ShakeOptions{} = conShakeOptions+    dataTypeOf _ = tyShakeOptions++shakeOptionsFields :: ShakeOptions -> [(String, String)]+shakeOptionsFields = zipExact fieldsShakeOptions . gmapQ f+    where+        f x | Just x <- cast x = show (x :: Int)+            | Just x <- cast x = show (x :: FilePath)+            | Just x <- cast x = show (x :: Verbosity)+            | Just x <- cast x = show (x :: Change)+            | Just x <- cast x = show (x :: Bool)+            | Just x <- cast x = show (x :: [FilePath])+            | Just x <- cast x = show (x :: [(Rebuild, FilePattern)])+            | Just x <- cast x = show (x :: Maybe Lint)+            | Just x <- cast x = show (x :: Maybe Double)+            | Just x <- cast x = show (x :: Maybe String)+            | Just x <- cast x = show (x :: [(String,String)])+            | Just x <- cast x = show (x :: Hidden (IO Progress -> IO ()))+            | Just x <- cast x = show (x :: Hidden (Verbosity -> String -> IO ()))+            | Just x <- cast x = show (x :: Hidden (Map.HashMap TypeRep Dynamic))+            | Just x <- cast x = show (x :: Hidden (String -> String -> Bool -> IO ()))+            | Just x <- cast x = show (x :: [CmdOption])+            | otherwise = throwImpure $ errorInternal $ "Error while showing ShakeOptions, missing alternative for " ++ show (typeOf x)++instance Show ShakeOptions where+    show x = "ShakeOptions {" ++ intercalate ", " (map (\(a,b) -> a ++ " = " ++ b) $ shakeOptionsFields x) ++ "}"+++-- | Internal type, copied from Hide in Uniplate+newtype Hidden a = Hidden {fromHidden :: a}+    deriving Typeable++instance Show (Hidden a) where show _ = "<hidden>"++instance Typeable a => Data (Hidden a) where+    gfoldl _ z = z+    gunfold _ _ _ = error "Development.Shake.Types.ShakeProgress: gunfold not implemented - data type has no constructors"+    toConstr _ = error "Development.Shake.Types.ShakeProgress: toConstr not implemented - data type has no constructors"+    dataTypeOf _ = tyHidden++tyHidden = mkDataType "Development.Shake.Types.Hidden" []+++-- | The verbosity data type, used by 'shakeVerbosity'.+data Verbosity+    = Silent  -- ^ Don't print any messages.+    | Error     -- ^ Only print error messages.+    | Warn    -- ^ Print errors and warnings.+    | Info    -- ^ Print errors, warnings and @# /command-name/ (for /file-name/)@ when running a 'Development.Shake.traced' command.+    | Verbose -- ^ Print errors, warnings, full command lines when running a 'Development.Shake.command' or+              --   'Development.Shake.cmd' command and status messages when starting a rule.+    | Diagnostic -- ^ Print messages for virtually everything (mostly for debugging).+      deriving (Eq,Ord,Show,Read,Typeable,Data,Enum,Bounded)+++-- | Apply the 'shakeRebuild' flags to a file, determining the desired behaviour+shakeRebuildApply :: ShakeOptions -> (FilePath -> Rebuild)+shakeRebuildApply ShakeOptions{shakeRebuild=rs}+    | null rs = const RebuildNormal+    | otherwise = \x -> fromMaybe RebuildNormal $ firstJust (\(r,pat) -> if pat x then Just r else Nothing) rs2+        where rs2 = map (second (?==)) $ reverse rs+++shakeAbbreviationsApply :: ShakeOptions -> String -> String+shakeAbbreviationsApply ShakeOptions{shakeAbbreviations=abbrev}+    | null abbrev = id+    | otherwise = f+        where+            -- order so longer abbreviations are preferred+            ordAbbrev = sortOn (negate . length . fst) abbrev++            f [] = []+            f x | (to,rest):_ <- [(to,rest) | (from,to) <- ordAbbrev, Just rest <- [stripPrefix from x]] = to ++ f rest+            f (x:xs) = x : f xs
+ src/Development/Shake/Internal/Paths.hs view
@@ -0,0 +1,107 @@+{-# LANGUAGE CPP #-}++#ifdef FILE_EMBED+{-# LANGUAGE TemplateHaskell #-}+#endif++-- | The information from Paths_shake cleaned up+module Development.Shake.Internal.Paths(+    shakeVersionString,+    initDataDirectory,+    hasManualData, copyManualData,+    readDataFileHTML+    ) where++import Control.Monad.Extra+import Data.Version+import System.FilePath+import General.Extra+import qualified Data.ByteString.Lazy as LBS+import Paths_shake++#ifdef FILE_EMBED+import qualified Data.ByteString as BS+import Data.FileEmbed+#else+import Control.Exception+import System.Directory+import System.Info.Extra+import System.IO.Unsafe+import System.Environment+#endif++shakeVersionString :: String+shakeVersionString = showVersion version++#ifdef FILE_EMBED++initDataDirectory :: IO ()+initDataDirectory = pure ()++htmlDataFiles :: [(FilePath, BS.ByteString)]+htmlDataFiles =+  [ ("profile.html",  $(embedFile "html/profile.html"))+  , ("progress.html", $(embedFile "html/progress.html"))+  , ("shake.js",      $(embedFile "html/shake.js"))+  ]++readDataFileHTML :: FilePath -> IO LBS.ByteString+readDataFileHTML file = do+    case lookup file htmlDataFiles of+      Nothing -> fail $ "Could not find data file " ++ file ++ " in embedded data files!"+      Just x  -> pure (LBS.fromStrict x)++manualDirData :: [(FilePath, BS.ByteString)]+manualDirData = $(embedDir "docs/manual")++hasManualData :: IO Bool+hasManualData = pure True++copyManualData :: FilePath -> IO ()+copyManualData dest = do+    createDirectoryRecursive dest+    forM_ manualDirData $ \(file, bs) -> do+        BS.writeFile (dest </> file) bs++#else+-- We want getDataFileName to be relative to the current directory on program startup,+-- even if we issue a change directory command. Therefore, first call caches, future ones read.+{-# NOINLINE dataDirs #-}+dataDirs :: [String]+dataDirs = unsafePerformIO $ do+    datdir <- getDataDir+    exedir <- takeDirectory <$> getExecutablePath `catchIO` \_ -> pure ""+    curdir <- getCurrentDirectory+    pure $ [datdir] ++ [exedir | exedir /= ""] ++ [curdir]++-- The data files may be located relative to the current directory, if so cache it in advance+initDataDirectory :: IO ()+initDataDirectory = void $ evaluate dataDirs++getDataFile :: FilePath -> IO FilePath+getDataFile file = do+    let poss = map (</> file) dataDirs+    res <- filterM doesFileExist_ poss+    case res of+        [] -> fail $ unlines $ ("Could not find data file " ++ file ++ ", looked in:") : map ("  " ++) poss+        x:_ -> pure x++hasDataFile :: FilePath -> IO Bool+hasDataFile file = anyM (\dir -> doesFileExist_ $ dir </> file) dataDirs++readDataFileHTML :: FilePath -> IO LBS.ByteString+readDataFileHTML file = LBS.readFile =<< getDataFile ("html" </> file)++manualFiles :: [FilePath]+manualFiles = map ("docs/manual" </>) ["Shakefile.hs","main.c","constants.c","constants.h","build" <.> if isWindows then "bat" else "sh"]++hasManualData :: IO Bool+hasManualData = allM hasDataFile manualFiles++copyManualData :: FilePath -> IO ()+copyManualData dest = do+    createDirectoryRecursive dest+    forM_ manualFiles $ \file -> do+        src <- getDataFile file+        copyFile src (dest </> takeFileName file)+#endif
+ src/Development/Shake/Internal/Profile.hs view
@@ -0,0 +1,174 @@+{-# LANGUAGE PatternGuards, RecordWildCards #-}++module Development.Shake.Internal.Profile(writeProfile) where++import General.Template+import Data.Tuple.Extra+import Data.Function+import Data.List.Extra+import Data.Maybe+import System.FilePath+import System.IO.Extra+import Numeric.Extra+import General.Extra+import Development.Shake.Internal.Errors+import Development.Shake.Internal.Core.Types+import Development.Shake.Internal.Core.Database+import Development.Shake.Internal.Value+import qualified Data.HashSet as Set+import Development.Shake.Internal.Paths+import Development.Shake.Classes+import System.Time.Extra+import qualified Data.HashMap.Strict as Map+import qualified Data.ByteString.Lazy.Char8 as LBS+import qualified Data.ByteString.Char8 as BS+import General.Intern(Id)+++-- | Given a map of representing a dependency order (with a show for error messages), find an ordering for the items such+--   that no item points to an item before itself.+--   Raise an error if you end up with a cycle.+dependencyOrder :: (Eq a, Hashable a) => (a -> String) -> Map.HashMap a [a] -> [a]+-- Algorithm:+--    Divide everyone up into those who have no dependencies [Id]+--    And those who depend on a particular Id, Dep :-> Maybe [(Key,[Dep])]+--    Where d :-> Just (k, ds), k depends on firstly d, then remaining on ds+--    For each with no dependencies, add to list, then take its dep hole and+--    promote them either to Nothing (if ds == []) or into a new slot.+--    k :-> Nothing means the key has already been freed+dependencyOrder shw status = f (map fst noDeps) $ Map.map Just $ Map.fromListWith (++) [(d, [(k,ds)]) | (k,d:ds) <- hasDeps]+    where+        (noDeps, hasDeps) = partition (null . snd) $ Map.toList status++        f [] mp | null bad = []+                | otherwise = throwImpure $ errorInternal $ unlines $+                    "Internal invariant broken, database seems to be cyclic" :+                    map ("    " ++) bad +++                    ["... plus " ++ show (length badOverflow) ++ " more ..." | not $ null badOverflow]+            where (bad,badOverflow) = splitAt 10 [shw i | (i, Just _) <- Map.toList mp]++        f (x:xs) mp = x : f (now++xs) later+            where Just free = Map.lookupDefault (Just []) x mp+                  (now,later) = foldl' g ([], Map.insert x Nothing mp) free++        g (free, mp) (k, []) = (k:free, mp)+        g (free, mp) (k, d:ds) = case Map.lookupDefault (Just []) d mp of+            Nothing -> g (free, mp) (k, ds)+            Just todo -> (free, Map.insert d (Just $ (k,ds) : todo) mp)+++-- | Eliminate all errors from the database, pretending they don't exist+resultsOnly :: Map.HashMap Id (Key, Status) -> Map.HashMap Id (Key, Result (Either BS.ByteString Value))+resultsOnly mp = Map.map (\(k, v) -> (k, let Just r = getResult v in r{depends = map (Depends . filter (isJust . flip Map.lookup keep) . fromDepends) $ depends r})) keep+    where keep = Map.filter (isJust . getResult . snd) mp++removeStep :: Map.HashMap Id (Key, Result a) -> Map.HashMap Id (Key, Result a)+removeStep = Map.filter (\(k,_) -> k /= stepKey)++toReport :: Database -> IO [ProfileEntry]+toReport db = do+    status <- removeStep . resultsOnly <$> getKeyValuesFromId db+    let order = let shw i = maybe "<unknown>" (show . fst) $ Map.lookup i status+                in dependencyOrder shw $ Map.map (concatMap fromDepends . depends . snd) status+        ids = Map.fromList $ zip order [0..]++        steps = let xs = Set.toList $ Set.fromList $ concat [[changed, built] | (_,Result{..}) <- Map.elems status]+                in Map.fromList $ zip (sortBy (flip compare) xs) [0..]++        f (k, Result{..}) = ProfileEntry+            {prfName = show k+            ,prfBuilt = fromStep built+            ,prfChanged = fromStep changed+            ,prfDepends = filter (not . null) $ map (mapMaybe (`Map.lookup` ids) . fromDepends) depends+            ,prfExecution = floatToDouble execution+            ,prfTraces = map fromTrace $ sortOn traceStart traces+            }+            where fromStep i = fromJust $ Map.lookup i steps+                  fromTrace (Trace a b c) = ProfileTrace (BS.unpack a) (floatToDouble b) (floatToDouble c)+    pure [maybe (throwImpure $ errorInternal "toReport") f $ Map.lookup i status | i <- order]+++data ProfileEntry = ProfileEntry+    {prfName :: String, prfBuilt :: Int, prfChanged :: Int, prfDepends :: [[Int]], prfExecution :: Double, prfTraces :: [ProfileTrace]}+data ProfileTrace = ProfileTrace+    {prfCommand :: String, prfStart :: Double, prfStop :: Double}+prfTime ProfileTrace{..} = prfStop - prfStart++-- | Generates an report given some build system profiling data.+writeProfile :: FilePath -> Database -> IO ()+writeProfile out db = writeProfileInternal out =<< toReport db++writeProfileInternal :: FilePath -> [ProfileEntry] -> IO ()+writeProfileInternal out xs+    | takeExtension out == ".js" = writeFileBinary out $ "var profile = \n" ++ generateJSON xs+    | takeExtension out == ".json" = writeFileBinary out $ generateJSON xs+    | takeExtension out == ".trace" = writeFileBinary out $ generateTrace xs+    | out == "-" = putStr $ unlines $ generateSummary xs+    -- NOTE: On my laptop writing 1.5Mb of profile report takes 0.6s.+    --       This is fundamentals of my laptop, not a Haskell profiling issue.+    --       Verified with similar "type foo > bar" commands taking similar time.+    | otherwise = LBS.writeFile out =<< generateHTML xs+++generateSummary :: [ProfileEntry] -> [String]+generateSummary xs =+    ["* This database has tracked " ++ show (maximum (0 : map prfChanged xs) + 1) ++ " runs."+    ,let f = show . length in "* There are " ++ f xs ++ " rules (" ++ f ls ++ " rebuilt in the last run)."+    ,let f = show . sum . map (length . prfTraces) in "* Building required " ++ f xs ++ " traced commands (" ++ f ls ++ " in the last run)."+    ,"* The total (unparallelised) time is " ++ showDuration (sum $ map prfExecution xs) +++        " of which " ++ showDuration (sum $ map prfTime $ concatMap prfTraces xs) ++ " is traced commands."+    ,let f xs = if null xs then "0s" else (\(a,b) -> showDuration a ++ " (" ++ b ++ ")") $ maximumBy' (compare `on` fst) xs in+        "* The longest rule takes " ++ f (map (prfExecution &&& prfName) xs) +++        ", and the longest traced command takes " ++ f (map (prfTime &&& prfCommand) $ concatMap prfTraces xs) ++ "."+    ,let sumLast = sum $ map prfTime $ concatMap prfTraces ls+         maxStop = maximum $ 0 : map prfStop (concatMap prfTraces ls) in+        "* Last run gave an average parallelism of " ++ showDP 2 (if maxStop == 0 then 0 else sumLast / maxStop) +++        " times over " ++ showDuration maxStop ++ "."+    ]+    where ls = filter ((==) 0 . prfBuilt) xs+++generateHTML :: [ProfileEntry] -> IO LBS.ByteString+generateHTML xs = do+    report <- readDataFileHTML "profile.html"+    let f "data/profile-data.js" = pure $ LBS.pack $ "var profile =\n" ++ generateJSON xs+    runTemplate f report+++generateTrace :: [ProfileEntry] -> String+generateTrace xs = jsonListLines $+    showEntries 0 [y{prfCommand=prfName x} | x <- onlyLast, y <- prfTraces x] +++    showEntries 1 (concatMap prfTraces onlyLast)+    where+        onlyLast = filter (\x -> prfBuilt x == 0) xs+        showEntries pid xs = map (showEntry pid) $ snd $ mapAccumL alloc [] $ sortOn prfStart xs++        alloc :: [ProfileTrace] -> ProfileTrace -> ([ProfileTrace], (Int, ProfileTrace))+        -- FIXME: I don't really understand what this code is doing, or the invariants it ensures+        alloc as r | (a1,_:a2) <- break (\a -> prfStop a <= prfStart r) as = (a1++r:a2, (length a1,r))+                   | otherwise = (as++[r], (length as,r))++        showEntry pid (tid, ProfileTrace{..}) = jsonObject+            [("args","{}"), ("ph",show "X"), ("cat",show "target")+            ,("name",show prfCommand), ("tid",show tid), ("pid",show pid)+            ,("ts",show $ 1000000*prfStart), ("dur",show $ 1000000*(prfStop-prfStart))]+++generateJSON :: [ProfileEntry] -> String+generateJSON = jsonListLines . map showEntry+    where+        showEntry ProfileEntry{..} = jsonList $+            [show prfName+            ,showTime prfExecution+            ,show prfBuilt+            ,show prfChanged] +++            [show prfDepends | not (null prfDepends) || not (null prfTraces)] +++            [jsonList $ map showTrace prfTraces | not (null prfTraces)]+        showTrace ProfileTrace{..} = jsonList+            [show prfCommand, showTime prfStart, showTime prfStop]+        showTime x = if '.' `elem` y then dropWhileEnd (== '.') $ dropWhileEnd (== '0') y else y+            where y = showDP 4 x++jsonListLines xs = "[" ++ intercalate "\n," xs ++ "\n]"+jsonList xs = "[" ++ intercalate "," xs ++ "]"+jsonObject xs = "{" ++ intercalate "," [show a ++ ":" ++ b | (a,b) <- xs] ++ "}"
+ src/Development/Shake/Internal/Progress.hs view
@@ -0,0 +1,347 @@+{-# LANGUAGE RecordWildCards, CPP, ViewPatterns, ForeignFunctionInterface, TupleSections #-}++-- | Progress tracking+module Development.Shake.Internal.Progress(+    progress,+    progressSimple, progressDisplay, progressTitlebar, progressProgram,+    ProgressEntry(..), progressReplay, writeProgressReport -- INTERNAL USE ONLY+    ) where++import Control.Applicative+import Data.Tuple.Extra+import Control.Exception.Extra+import Control.Monad.Extra+import System.Directory+import System.Process+import System.FilePath+import Data.Char+import Data.IORef+import Data.List+import Data.Maybe+import Development.Shake.Internal.Options+import Development.Shake.Internal.Core.Types+import Development.Shake.Internal.Core.Database+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy.Char8 as LBS+import Numeric.Extra+import General.Template+import General.EscCodes+import General.Extra+import Development.Shake.Internal.Paths+import System.Time.Extra+++#ifdef mingw32_HOST_OS++import Foreign.C.String++#ifdef x86_64_HOST_ARCH+#define CALLCONV ccall+#else+#define CALLCONV stdcall+#endif++foreign import CALLCONV "Windows.h SetConsoleTitleW" c_setConsoleTitleW :: CWString -> IO Bool++#endif++++---------------------------------------------------------------------+-- PROGRESS++progress :: Database -> Step -> IO Progress+progress db step = do+    xs <- getKeyValues db+    pure $! foldl' f mempty $ map snd xs+    where+        g = floatToDouble++        f s (Ready Result{..}) = if step == built+            then s{countBuilt = countBuilt s + 1, timeBuilt = timeBuilt s + g execution}+            else s{countSkipped = countSkipped s + 1, timeSkipped = timeSkipped s + g execution}+        f s (Loaded Result{..}) = s{countUnknown = countUnknown s + 1, timeUnknown = timeUnknown s + g execution}+        f s (Running _ r) =+            let (d,c) = timeTodo s+                t | Just Result{..} <- r = let d2 = d + g execution in d2 `seq` (d2,c)+                  | otherwise = let c2 = c + 1 in c2 `seq` (d,c2)+            in s{countTodo = countTodo s + 1, timeTodo = t}+        f s _ = s++++---------------------------------------------------------------------+-- MEALY TYPE - for writing the progress functions+-- See <https://hackage.haskell.org/package/machines-0.2.3.1/docs/Data-Machine-Mealy.html>++-- | A machine that takes inputs and produces outputs+newtype Mealy i a = Mealy {runMealy :: i -> (a, Mealy i a)}++instance Functor (Mealy i) where+    fmap f (Mealy m) = Mealy $ \i -> case m i of+        (x, m) -> (f x, fmap f m)++instance Applicative (Mealy i) where+    pure x = let r = Mealy (const (x, r)) in r+    Mealy mf <*> Mealy mx = Mealy $ \i -> case mf i of+        (f, mf) -> case mx i of+            (x, mx) -> (f x, mf <*> mx)++echoMealy :: Mealy i i+echoMealy = Mealy (,echoMealy)++scanMealy :: (a -> b -> a) -> a -> Mealy i b -> Mealy i a+scanMealy f z (Mealy m) = Mealy $ \i -> case m i of+    (x, m) -> let z2 = f z x in (z2, scanMealy f z2 m)+++---------------------------------------------------------------------+-- MEALY UTILITIES++oldMealy :: a -> Mealy i a -> Mealy i (a,a)+oldMealy old = scanMealy (\(_,old) new -> (old,new)) (old,old)++latch :: Mealy i (Bool, a) -> Mealy i a+latch s = fromJust <$> scanMealy f Nothing s+    where f old (b,v) = Just $ if b then fromMaybe v old else v++iff :: Mealy i Bool -> Mealy i a -> Mealy i a -> Mealy i a+iff c t f = (\c t f -> if c then t else f) <$> c <*> t <*> f++-- decay'd division, compute a/b, with a decay of f+-- r' is the new result, r is the last result+-- r' ~= a' / b'+-- r' = r*b + f*(a'-a)+--      -------------+--      b + f*(b'-b)+-- when f == 1, r == r'+--+-- both streams must only ever increase+decay :: Double -> Mealy i Double -> Mealy i Double -> Mealy i Double+decay f a b = scanMealy step 0 $ (,) <$> oldMealy 0 a <*> oldMealy 0 b+    where step r ((a,a'),(b,b')) = if isNaN r then a' / b' else ((r*b) + f*(a'-a)) / (b + f*(b'-b))+++---------------------------------------------------------------------+-- MESSAGE GENERATOR++formatMessage :: Double -> Double -> String+formatMessage secs perc =+    (if isNaN secs || secs < 0 then "??s" else showMinSec $ ceiling secs) ++ " (" +++    (if isNaN perc || perc < 0 || perc > 100 then "??" else show $ floor perc) ++ "%)"++showMinSec :: Int -> String+showMinSec secs = (if m == 0 then "" else show m ++ "m" ++ ['0' | s < 10]) ++ show s ++ "s"+    where (m,s) = divMod secs 60++liftA2' :: Applicative m => m a -> m b -> (a -> b -> c) -> m c+liftA2' a b f = liftA2 f a b+++-- | return (number of seconds, percentage, explanation)+message :: Mealy (Double, Progress) (Double, Progress) -> Mealy (Double, Progress) (Double, Double, String)+message input = liftA3 (,,) time perc debug+    where+        progress = snd <$> input+        secs = fst <$> input+        debug = (\donePerSec ruleTime (todoKnown,todoUnknown) ->+            "Progress: " +++                "((known=" ++ showDP 2 todoKnown ++ "s) + " +++                "(unknown=" ++ show todoUnknown ++ " * time=" ++ showDP 2 ruleTime ++ "s)) " +++                "(rate=" ++ showDP 2 donePerSec ++ "))")+            <$> donePerSec <*> ruleTime <*> (timeTodo <$> progress)++        -- Number of seconds work completed in this build run+        -- Ignores timeSkipped which would be more truthful, but it makes the % drop sharply+        -- which isn't what users want+        done = timeBuilt <$> progress++        -- Work done per second, don't divide by 0 and don't update if 'done' doesn't change+        donePerSec = iff ((==) 0 <$> done) (pure 1) perSecStable+            where perSecStable = latch $ liftA2 (,) (uncurry (==) <$> oldMealy 0 done) perSecRaw+                  perSecRaw = decay 1.2 done secs++        -- Predicted build time for a rule that has never been built before+        -- The high decay means if a build goes in "phases" - lots of source files, then lots of compiling+        -- we reach a reasonable number fairly quickly, without bouncing too much+        ruleTime = liftA2 weightedAverage+            (f (decay 10) timeBuilt countBuilt)+            (f (liftA2 (/)) (fst . timeTodo) (\Progress{..} -> countTodo - snd timeTodo))+            -- don't call decay on todo, since it goes up and down (as things get done)+            where+                weightedAverage (w1,x1) (w2,x2)+                    | w1 == 0 && w2 == 0 = 0+                    | otherwise = ((w1 *. x1) + (w2 *. x2)) / intToDouble (w1+w2)+                    where i *. d = if i == 0 then 0 else intToDouble i * d -- since d might be NaN++                f divide time count = let xs = count <$> progress in liftA2 (,) xs $ divide (time <$> progress) (intToDouble <$> xs)++        -- Number of seconds work remaining, ignoring multiple threads+        todo = f <$> progress <*> ruleTime+            where f Progress{..} ruleTime = fst timeTodo + (fromIntegral (snd timeTodo) * ruleTime)++        -- Display information+        time = liftA2 (/) todo donePerSec+        perc = iff ((==) 0 <$> done) (pure 0) $+            liftA2' done todo $ \done todo -> 100 * done / (done + todo)+++---------------------------------------------------------------------+-- EXPOSED FUNCTIONS++-- | Given a sampling interval (in seconds) and a way to display the status message,+--   produce a function suitable for using as 'Development.Shake.shakeProgress'.+--   This function polls the progress information every /n/ seconds, produces a status+--   message and displays it using the display function.+--+--   Typical status messages will take the form of @1m25s (15%)@, indicating that the build+--   is predicted to complete in 1 minute 25 seconds (85 seconds total), and 15% of the necessary build time has elapsed.+--   This function uses past observations to predict future behaviour, and as such, is only+--   guessing. The time is likely to go up as well as down, and will be less accurate from a+--   clean build (as the system has fewer past observations).+--+--   The current implementation is to predict the time remaining (based on 'timeTodo') and the+--   work already done ('timeBuilt'). The percentage is then calculated as @remaining / (done + remaining)@,+--   while time left is calculated by scaling @remaining@ by the observed work rate in this build,+--   roughly @done / time_elapsed@.+progressDisplay :: Double -> (String -> IO ()) -> IO Progress -> IO ()+progressDisplay sample disp prog = do+    disp "Starting..." -- no useful info at this stage+    time <- offsetTime+    catchJust (\x -> if x == ThreadKilled then Just () else Nothing)+        (loop time $ message echoMealy)+        (const $ do t <- time; disp $ "Finished in " ++ showDuration t)+    where+        loop :: IO Double -> Mealy (Double, Progress) (Double, Double, String) -> IO ()+        loop time mealy = do+            sleep sample+            p <- prog+            t <- time+            ((secs,perc,_debug), mealy)<- pure $ runMealy mealy (t, p)+            -- putStrLn _debug+            let done = countSkipped p + countBuilt p+            let todo = done + countUnknown p + countTodo p+            disp $+                "Running for " ++ showDurationSecs t ++ " [" ++ show done ++ "/" ++ show todo ++ "]" +++                ", predicted " ++ formatMessage secs perc +++                maybe "" (", Failure! " ++) (isFailure p)+            loop time mealy+++data ProgressEntry = ProgressEntry+    {idealSecs :: Double, idealPerc :: Double+    ,actualSecs :: Double, actualPerc :: Double+    }++isInvalid :: ProgressEntry -> Bool+isInvalid ProgressEntry{..} = isNaN actualSecs || isNaN actualPerc+++-- | Given a list of progress inputs, what would you have suggested (seconds, percentage)+progressReplay :: [(Double, Progress)] -> [ProgressEntry]+progressReplay [] = []+progressReplay ps = snd $ mapAccumL f (message echoMealy) ps+    where+        end = fst $ last ps+        f a (time,p) = (a2, ProgressEntry (end - time) (time * 100 / end) secs perc)+            where ((secs,perc,_),a2) = runMealy a (time,p)+++-- | Given a trace, display information about how well we did+writeProgressReport :: FilePath -> [(FilePath, [(Double, Progress)])] -> IO ()+writeProgressReport out (map (second progressReplay) -> xs)+    | (bad,_):_ <- filter (any isInvalid . snd) xs = errorIO $ "Progress generates NaN for " ++ bad+    | takeExtension out == ".js" = writeFile out $ "var shake = \n" ++ generateJSON xs+    | takeExtension out == ".json" = writeFile out $ generateJSON xs+    | out == "-" = putStr $ unlines $ generateSummary xs+    | otherwise = LBS.writeFile out =<< generateHTML xs+++generateSummary :: [(FilePath, [ProgressEntry])] -> [String]+generateSummary xs = flip concatMap xs $ \(file,xs) ->+    ["# " ++ file, f xs "Seconds" idealSecs actualSecs, f xs "Percent" idealPerc actualPerc]+    where+        levels = [100,90,80,50]+        f xs lbl ideal actual = lbl ++ ": " ++ intercalate ", "+            [show l ++ "% within " ++ show (ceiling $ maximum $ 0 : take ((length xs * l) `div` 100) diff) | l <- levels]+            where diff = sort [abs $ ideal x - actual x | x <- xs]+++generateHTML :: [(FilePath, [ProgressEntry])] -> IO LBS.ByteString+generateHTML xs = do+    report <- readDataFileHTML "progress.html"+    let f "data/progress-data.js" = pure $ LBS.pack $ "var progress =\n" ++ generateJSON xs+    runTemplate f report++generateJSON :: [(FilePath, [ProgressEntry])] -> String+generateJSON = concat . jsonList . map ((++"}") . unlines . f)+    where+        f (file,ps) =+            ("{\"name\":" ++ show (takeFileName file) ++ ", \"values\":") :+            indent (jsonList $ map g ps)++        shw = showDP 1+        g ProgressEntry{..} = jsonObject+            [("idealSecs",shw idealSecs),("idealPerc",shw idealPerc)+            ,("actualSecs",shw actualSecs),("actualPerc",shw actualPerc)]++indent = map ("  "++)+jsonList xs = zipWith (:) ('[':repeat ',') xs ++ ["]"]+jsonObject xs = "{" ++ intercalate ", " [show a ++ ":" ++ b | (a,b) <- xs] ++ "}"+++-- | Set the title of the current console window to the given text. If the+--   environment variable @$TERM@ is set to @xterm@ this uses xterm escape sequences.+--   On Windows, if not detected as an xterm, this function uses the @SetConsoleTitle@ API.+progressTitlebar :: String -> IO ()+progressTitlebar x = unlessM win lin+    where+#ifdef mingw32_HOST_OS+        win = withCWString x c_setConsoleTitleW+#else+        win = pure False+#endif++        lin = whenM checkEscCodes $ BS.putStr $ BS.pack $ escWindowTitle x+++-- | Call the program @shake-progress@ if it is on the @$PATH@. The program is called with+--   the following arguments:+--+-- * @--title=string@ - the string passed to @progressProgram@.+--+-- * @--state=Normal@, or one of @NoProgress@, @Normal@, or @Error@ to indicate+--   what state the progress bar should be in.+--+-- * @--value=25@ - the percent of the build that has completed, if not in @NoProgress@ state.+--+--   The program will not be called consecutively with the same @--state@ and @--value@ options.+--+--   Windows 7 or higher users can get taskbar progress notifications by placing the following+--   program in their @$PATH@: <https://github.com/ndmitchell/shake/releases>.+progressProgram :: IO (String -> IO ())+progressProgram = do+    exe <- findExecutable "shake-progress"+    case exe of+        Nothing -> pure $ const $ pure ()+        Just exe -> do+            lastArgs <- newIORef Nothing -- the arguments we passed to shake-progress last time+            pure $ \msg -> do+                let failure = " Failure! " `isInfixOf` msg+                let perc = let (a,b) = break (== '%') msg+                           in if null b then "" else reverse $ takeWhile isDigit $ reverse a+                let state | perc == "" = "NoProgress"+                          | failure = "Error"+                          | otherwise = "Normal"+                let args = ["--title=" ++ msg, "--state=" ++ state] ++ ["--value=" ++ perc | perc /= ""]+                same <- atomicModifyIORef lastArgs $ \old -> (Just args, old == Just args)+                unless same $ void $ rawSystem exe args+++-- | A simple method for displaying progress messages, suitable for using as 'Development.Shake.shakeProgress'.+--   This function writes the current progress to the titlebar every five seconds using 'progressTitlebar',+--   and calls any @shake-progress@ program on the @$PATH@ using 'progressProgram'.+progressSimple :: IO Progress -> IO ()+progressSimple p = do+    program <- progressProgram+    progressDisplay 5 (\s -> progressTitlebar s >> program s) p
+ src/Development/Shake/Internal/Resource.hs view
@@ -0,0 +1,185 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RecordWildCards, ViewPatterns #-}++module Development.Shake.Internal.Resource(+    Resource, newResourceIO, newThrottleIO, withResource+    ) where++import Data.Function+import System.IO.Unsafe+import Control.Concurrent.Extra+import General.Fence+import Control.Exception.Extra+import Data.Tuple.Extra+import Data.IORef+import Control.Monad.Extra+import General.Bilist+import General.Pool+import Development.Shake.Internal.Core.Action+import Development.Shake.Internal.Core.Types+import Development.Shake.Internal.Core.Monad+import Development.Shake.Internal.Core.Pool+import Control.Monad.IO.Class+import System.Time.Extra+++{-# NOINLINE resourceId #-}+resourceId :: IO Int+resourceId = unsafePerformIO resourceCounter++-- Work around for GHC bug https://gitlab.haskell.org/ghc/ghc/-/issues/19413+{-# NOINLINE  resourceCounter #-}+resourceCounter :: IO (IO Int)+resourceCounter = do+    ref <- newIORef 0+    pure $ atomicModifyIORef' ref $ \i -> let j = i + 1 in (j, j)+++-- | Run an action which uses part of a finite resource. For more details see 'Resource'.+--   You cannot depend on a rule (e.g. 'need') while a resource is held.+withResource :: Resource -> Int -> Action a -> Action a+withResource r i act = do+    Global{..} <- Action getRO+    liftIO $ globalDiagnostic $ pure $ show r ++ " waiting to acquire " ++ show i++    fence <- liftIO $ acquireResource r globalPool i+    whenJust fence $ \fence -> do+        (offset, ()) <- actionFenceRequeueBy Right fence+        Action $ modifyRW $ addDiscount offset++    liftIO $ globalDiagnostic $ pure $ show r ++ " running with " ++ show i+    Action $ fromAction (blockApply ("Within withResource using " ++ show r) act) `finallyRAW` do+        liftIO $ releaseResource r globalPool i+        liftIO $ globalDiagnostic $ pure $ show r ++ " released " ++ show i++++-- | A type representing an external resource which the build system should respect. There+--   are two ways to create 'Resource's in Shake:+--+-- * 'Development.Shake.newResource' creates a finite resource, stopping too many actions running+--   simultaneously.+--+-- * 'Development.Shake.newThrottle' creates a throttled resource, stopping too many actions running+--   over a short time period.+--+--   These resources are used with 'Development.Shake.withResource' when defining rules. Typically only+--   system commands (such as 'Development.Shake.cmd') should be run inside 'Development.Shake.withResource',+--   not commands such as 'Development.Shake.need'.+--+--   Be careful that the actions run within 'Development.Shake.withResource' do not themselves require further+--   resources, or you may get a \"thread blocked indefinitely in an MVar operation\" exception.+--   If an action requires multiple resources, use 'Development.Shake.withResources' to avoid deadlock.+data Resource = Resource+    {resourceOrd :: Int+        -- ^ Key used for Eq/Ord operations. To make withResources work, we require newResourceIO < newThrottleIO+    ,resourceShow :: String+        -- ^ String used for Show+    ,acquireResource :: Pool -> Int -> IO (Maybe (Fence IO ()))+        -- ^ Acquire the resource and call the function.+    ,releaseResource :: Pool -> Int -> IO ()+        -- ^ You should only ever releaseResource that you obtained with acquireResource.+    }++instance Show Resource where show = resourceShow+instance Eq Resource where (==) = (==) `on` resourceOrd+instance Ord Resource where compare = compare `on` resourceOrd+++---------------------------------------------------------------------+-- FINITE RESOURCES++data Finite = Finite+    {finiteAvailable :: !Int+        -- ^ number of currently available resources+    ,finiteWaiting :: Bilist (Int, Fence IO ())+        -- ^ queue of people with how much they want and the action when it is allocated to them+    }++-- | A version of 'Development.Shake.newResource' that runs in IO, and can be called before calling 'Development.Shake.shake'.+--   Most people should use 'Development.Shake.newResource' instead.+newResourceIO :: String -> Int -> IO Resource+newResourceIO name mx = do+    when (mx < 0) $+        errorIO $ "You cannot create a resource named " ++ name ++ " with a negative quantity, you used " ++ show mx+    key <- resourceId+    var <- newVar $ Finite mx mempty+    pure $ Resource (negate key) shw (acquire var) (release var)+    where+        shw = "Resource " ++ name++        acquire :: Var Finite -> Pool -> Int -> IO (Maybe (Fence IO ()))+        acquire var _ want+            | want < 0 = errorIO $ "You cannot acquire a negative quantity of " ++ shw ++ ", requested " ++ show want+            | want > mx = errorIO $ "You cannot acquire more than " ++ show mx ++ " of " ++ shw ++ ", requested " ++ show want+            | otherwise = modifyVar var $ \x@Finite{..} ->+                if want <= finiteAvailable then+                    pure (x{finiteAvailable = finiteAvailable - want}, Nothing)+                else do+                    fence <- newFence+                    pure (x{finiteWaiting = finiteWaiting `snoc` (want, fence)}, Just fence)++        release :: Var Finite -> Pool -> Int -> IO ()+        release var _ i = join $ modifyVar var $ \x -> pure $ f x{finiteAvailable = finiteAvailable x + i}+            where+                f (Finite i (uncons -> Just ((wi,wa),ws)))+                    | wi <= i = second (signalFence wa () >>) $ f $ Finite (i-wi) ws+                    | otherwise = first (add (wi,wa)) $ f $ Finite i ws+                f (Finite i _) = (Finite i mempty, pure ())+                add a s = s{finiteWaiting = a `cons` finiteWaiting s}+++---------------------------------------------------------------------+-- THROTTLE RESOURCES+++-- call a function after a certain delay+waiter :: Seconds -> IO () -> IO ()+waiter period act = void $ forkIO $ do+    sleep period+    act+++data Throttle+      -- | Some number of resources are available+    = ThrottleAvailable !Int+      -- | Some users are blocked (non-empty), plus an action to call once we go back to Available+    | ThrottleWaiting (IO ()) (Bilist (Int, Fence IO ()))+++-- | A version of 'Development.Shake.newThrottle' that runs in IO, and can be called before calling 'Development.Shake.shake'.+--   Most people should use 'Development.Shake.newThrottle' instead.+newThrottleIO :: String -> Int -> Double -> IO Resource+newThrottleIO name count period = do+    when (count < 0) $+        errorIO $ "You cannot create a throttle named " ++ name ++ " with a negative quantity, you used " ++ show count+    key <- resourceId+    var <- newVar $ ThrottleAvailable count+    pure $ Resource key shw (acquire var) (release var)+    where+        shw = "Throttle " ++ name++        acquire :: Var Throttle -> Pool -> Int -> IO (Maybe (Fence IO ()))+        acquire var pool want+            | want < 0 = errorIO $ "You cannot acquire a negative quantity of " ++ shw ++ ", requested " ++ show want+            | want > count = errorIO $ "You cannot acquire more than " ++ show count ++ " of " ++ shw ++ ", requested " ++ show want+            | otherwise = modifyVar var $ \case+                ThrottleAvailable i+                    | i >= want -> pure (ThrottleAvailable $ i - want, Nothing)+                    | otherwise -> do+                        stop <- keepAlivePool pool+                        fence <- newFence+                        pure (ThrottleWaiting stop $ (want - i, fence) `cons` mempty, Just fence)+                ThrottleWaiting stop xs -> do+                    fence <- newFence+                    pure (ThrottleWaiting stop $ xs `snoc` (want, fence), Just fence)++        release :: Var Throttle -> Pool -> Int -> IO ()+        release var _ n = waiter period $ join $ modifyVar var $ \x -> pure $ case x of+                ThrottleAvailable i -> (ThrottleAvailable $ i+n, pure ())+                ThrottleWaiting stop xs -> f stop n xs+            where+                f stop i (uncons -> Just ((wi,wa),ws))+                    | i >= wi = second (signalFence wa () >>) $ f stop (i-wi) ws+                    | otherwise = (ThrottleWaiting stop $ (wi-i,wa) `cons` ws, pure ())+                f stop i _ = (ThrottleAvailable i, stop)
+ src/Development/Shake/Internal/Rules/Default.hs view
@@ -0,0 +1,18 @@++module Development.Shake.Internal.Rules.Default(+    defaultRules+    ) where++import Development.Shake.Internal.Core.Rules+import Development.Shake.Internal.Rules.Directory+import Development.Shake.Internal.Rules.File+import Development.Shake.Internal.Rules.Files+import Development.Shake.Internal.Rules.Rerun++-- All the rules baked into Shake+defaultRules :: Rules ()+defaultRules = do+    defaultRuleFile+    defaultRuleFiles+    defaultRuleDirectory+    defaultRuleRerun
+ src/Development/Shake/Internal/Rules/Directory.hs view
@@ -0,0 +1,354 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables, DeriveDataTypeable #-}+{-# LANGUAGE TypeFamilies, TypeOperators, ConstraintKinds #-}++-- | Both System.Directory and System.Environment wrappers+module Development.Shake.Internal.Rules.Directory(+    doesFileExist, doesDirectoryExist,+    getDirectoryContents, getDirectoryFiles, getDirectoryDirs,+    getEnv, getEnvWithDefault, getEnvError,+    removeFiles, removeFilesAfter,+    getDirectoryFilesIO,+    defaultRuleDirectory+    ) where++import Control.Exception.Extra+import Control.Monad.Extra+import Control.Monad.IO.Class+import Data.Maybe+import Data.Binary+import Data.List+import Data.Tuple.Extra+import qualified Data.HashSet as Set+import qualified System.Directory as IO+import qualified System.Environment as IO++import Development.Shake.Internal.Core.Types+import Development.Shake.Internal.Core.Action+import Development.Shake.Internal.Core.Rules+import Development.Shake.Internal.Core.Build+import Development.Shake.Internal.Value+import Development.Shake.Classes+import Development.Shake.FilePath+import Development.Shake.Internal.FilePattern+import General.Extra+import General.Binary+++---------------------------------------------------------------------+-- KEY/VALUE TYPES++type instance RuleResult DoesFileExistQ = DoesFileExistA++newtype DoesFileExistQ = DoesFileExistQ FilePath+    deriving (Typeable,Eq,Hashable,Binary,BinaryEx,NFData)++instance Show DoesFileExistQ where+    show (DoesFileExistQ a) = "doesFileExist " ++ wrapQuote a++newtype DoesFileExistA = DoesFileExistA {fromDoesFileExistA :: Bool}+    deriving (Typeable,Eq,BinaryEx,NFData)++instance Show DoesFileExistA where+    show (DoesFileExistA a) = show a++type instance RuleResult DoesDirectoryExistQ = DoesDirectoryExistA++newtype DoesDirectoryExistQ = DoesDirectoryExistQ FilePath+    deriving (Typeable,Eq,Hashable,Binary,BinaryEx,NFData)++instance Show DoesDirectoryExistQ where+    show (DoesDirectoryExistQ a) = "doesDirectoryExist " ++ wrapQuote a++newtype DoesDirectoryExistA = DoesDirectoryExistA {fromDoesDirectoryExistA :: Bool}+    deriving (Typeable,Eq,BinaryEx,NFData)++instance Show DoesDirectoryExistA where+    show (DoesDirectoryExistA a) = show a+++type instance RuleResult GetEnvQ = GetEnvA++newtype GetEnvQ = GetEnvQ String+    deriving (Typeable,Eq,Hashable,Binary,BinaryEx,NFData)++instance Show GetEnvQ where+    show (GetEnvQ a) = "getEnv " ++ wrapQuote a++newtype GetEnvA = GetEnvA {fromGetEnvA :: Maybe String}+    deriving (Typeable,Eq,Hashable,BinaryEx,NFData)++instance Show GetEnvA where+    show (GetEnvA a) = maybe "<unset>" wrapQuote a+++type instance RuleResult GetDirectoryContentsQ = GetDirectoryA+type instance RuleResult GetDirectoryFilesQ = GetDirectoryA+type instance RuleResult GetDirectoryDirsQ = GetDirectoryA++newtype GetDirectoryContentsQ = GetDirectoryContentsQ FilePath+    deriving (Typeable,Eq,Hashable,Binary,BinaryEx,NFData)++instance Show GetDirectoryContentsQ where+    show (GetDirectoryContentsQ dir) = "getDirectoryContents " ++ wrapQuote dir++newtype GetDirectoryFilesQ = GetDirectoryFilesQ (FilePath, [FilePattern])+    deriving (Typeable,Eq,Hashable,Binary,BinaryEx,NFData)++instance Show GetDirectoryFilesQ where+    show (GetDirectoryFilesQ (dir, pat)) = "getDirectoryFiles " ++ wrapQuote dir ++ " [" ++ unwords (map wrapQuote pat) ++ "]"++newtype GetDirectoryDirsQ = GetDirectoryDirsQ FilePath+    deriving (Typeable,Eq,Hashable,Binary,BinaryEx,NFData)++instance Show GetDirectoryDirsQ where+    show (GetDirectoryDirsQ dir) = "getDirectoryDirs " ++ wrapQuote dir++newtype GetDirectoryA = GetDirectoryA {fromGetDirectoryA :: [FilePath]}+    deriving (Typeable,Eq,Hashable,BinaryEx,NFData)++instance Show GetDirectoryA where+    show (GetDirectoryA xs) = unwords $ map wrapQuote xs+++---------------------------------------------------------------------+-- RULE DEFINITIONS++queryRule :: (RuleResult key ~ value+             ,BinaryEx witness, Eq witness+             ,BinaryEx key, ShakeValue key+             ,Typeable value, NFData value, Show value, Eq value)+          => (value -> witness) -> (key -> IO value) -> Rules ()+queryRule witness query = addBuiltinRuleEx+    (\k old -> do+        new <- query k+        pure $ if old == new then Nothing else Just $ show new)+    (\_ v -> Just $ runBuilder $ putEx $ witness v)+    (\k old _ -> liftIO $ do+        new <- query k+        let wnew = witness new+        pure $ case old of+            Just old | wnew == getEx old -> RunResult ChangedNothing old new+            _ -> RunResult ChangedRecomputeDiff (runBuilder $ putEx wnew) new)+++defaultRuleDirectory :: Rules ()+defaultRuleDirectory = do+    -- for things we are always going to rerun, and which might take up a lot of memory to store,+    -- we only store their hash, so we can compute change, but not know what changed happened+    queryRule id (\(DoesFileExistQ x) -> DoesFileExistA <$> IO.doesFileExist x)+    queryRule id (\(DoesDirectoryExistQ x) -> DoesDirectoryExistA <$> IO.doesDirectoryExist x)+    queryRule hash (\(GetEnvQ x) -> GetEnvA <$> IO.lookupEnv x)+    queryRule hash (\(GetDirectoryContentsQ x) -> GetDirectoryA <$> getDirectoryContentsIO x)+    queryRule hash (\(GetDirectoryFilesQ (a,b)) -> GetDirectoryA <$> getDirectoryFilesIO a b)+    queryRule hash (\(GetDirectoryDirsQ x) -> GetDirectoryA <$> getDirectoryDirsIO x)+++---------------------------------------------------------------------+-- RULE ENTRY POINTS++-- | Returns 'True' if the file exists. The existence of the file is tracked as a+--   dependency, and if the file is created or deleted the rule will rerun in subsequent builds.+--   Usually used to implement include paths. For example, given a include path of @foo@ and @bar@,+--   and a file @hello.txt@, you might write:+--+-- @+-- b <- 'doesFileExist' \"foo\/hello.txt\"+-- let file = if b then \"foo\/hello.txt\" else "\bar\/hello.txt\"+-- @+--+--   Now if the user had a file @bar\/hello.txt@, and then creates a file @foo\/hello.txt@, the+--   rule would correctly rerun, as while the @hello.txt@ that was used didn't change, which+--   file should be used has changed.+--+--   You should not call 'doesFileExist' on files which can be created by the build system.+--   The reason is that Shake operations such as this one are both cached for the duration of the build,+--   and may be run preemptively during a recheck. That means you can't control the time at which+--   'doesFileExist' is called. For that to be consistent, 'doesFileExist' must return the same result at the+--   start and end of the build, a property that is partially checked by the @--lint@ flag. Given a+--   file created by the build system, a build from clean will return 'False' at the beginning and 'True'+--   at the end, leading to a change, and thus rebuilds in subsequent runs.+--+--   If you do want to know whether a file exists separate to the build system, e.g. you can perfectly+--   predict the files contents and can save some meaningful work if the file already exists, you should+--   use the untracked "System.Directory" version. Such calls are not tracked by the file system, and you+--   should take care not to result in unpredictable results.+doesFileExist :: FilePath -> Action Bool+doesFileExist = fmap fromDoesFileExistA . apply1 . DoesFileExistQ . toStandard++-- | Returns 'True' if the directory exists. The existence of the directory is tracked as a+--   dependency, and if the directory is created or delete the rule will rerun in subsequent builds.+--+--   You should not call 'doesDirectoryExist' on directories which can be created by the build system,+--   for reasons explained in 'doesFileExist'.+doesDirectoryExist :: FilePath -> Action Bool+doesDirectoryExist = fmap fromDoesDirectoryExistA . apply1 . DoesDirectoryExistQ . toStandard++-- | Return 'Just' the value of the environment variable, or 'Nothing'+--   if the variable is not set. The environment variable is tracked as a+--   dependency, and if it changes the rule will rerun in subsequent builds.+--   This function is a tracked version of 'getEnv' / 'lookupEnv' from the base library.+--+-- @+-- flags <- getEnv \"CFLAGS\"+-- 'cmd' \"gcc -c\" [out] (maybe [] words flags)+-- @+getEnv :: String -> Action (Maybe String)+getEnv = fmap fromGetEnvA . apply1 . GetEnvQ++-- | @'getEnvWithDefault' def var@ returns the value of the environment variable @var@, or the+--   default value @def@ if it is not set. Similar to 'getEnv'.+--+-- @+-- flags <- getEnvWithDefault \"-Wall\" \"CFLAGS\"+-- 'cmd' \"gcc -c\" [out] flags+-- @+getEnvWithDefault :: String -> String -> Action String+getEnvWithDefault def var = fromMaybe def <$> getEnv var++-- | A partial variant of 'getEnv' that returns the environment variable variable or fails.+getEnvError :: Partial => String -> Action String+getEnvError name = getEnvWithDefault (error $ "getEnvError: Environment variable " ++ name ++ " is undefined") name++-- | Get the contents of a directory. The result will be sorted, and will not contain+--   the entries @.@ or @..@ (unlike the standard Haskell version).+--   The resulting paths will be relative to the first argument.+--   The result itself is tracked as a dependency, but the files in the result are not.+--   If the list of files changes in subsequent builds any rule calling it will rerun.+--+--   It is usually simpler to call either 'getDirectoryFiles' or 'getDirectoryDirs'.+getDirectoryContents :: FilePath -> Action [FilePath]+getDirectoryContents = fmap fromGetDirectoryA . apply1 . GetDirectoryContentsQ++-- | Get the files anywhere under a directory that match any of a set of patterns.+--   For the interpretation of the patterns see '?=='. All results will be+--   relative to the directory argument.+--   The result itself is tracked as a dependency, but the files in the result are not.+--   If the list of files changes in subsequent builds any rule calling it will rerun.+--   Some examples:+--+-- > getDirectoryFiles "Config" ["//*.xml"]+-- >     -- All .xml files anywhere under the Config directory+-- >     -- If Config/foo/bar.xml exists it will return ["foo/bar.xml"]+-- > getDirectoryFiles "Modules" ["*.hs","*.lhs"]+-- >     -- All .hs or .lhs in the Modules directory+-- >     -- If Modules/foo.hs and Modules/foo.lhs exist, it will return ["foo.hs","foo.lhs"]+--+--   If you require a qualified file name it is often easier to use @\"\"@ as the 'FilePath' argument,+--   for example the following two expressions are equivalent:+--+-- > fmap (map ("Config" </>)) (getDirectoryFiles "Config" ["//*.xml"])+-- > getDirectoryFiles "" ["Config//*.xml"]+--+--   If the first argument directory does not exist it will raise an error.+--   If @foo@ does not exist, then the first of these error, but the second will not.+--+-- > getDirectoryFiles "foo" ["//*"] -- error+-- > getDirectoryFiles "" ["foo//*"] -- returns []+--+--   This function is tracked and serves as a dependency. If a rule calls+--   @getDirectoryFiles \"\" [\"*.c\"]@ and someone adds @foo.c@ to the+--   directory, that rule will rebuild. If someone changes one of the @.c@ files,+--   but the /list/ of @.c@ files doesn't change, then it will not rebuild.+--   As a consequence of being tracked, if the contents change during the build+--   (e.g. you are generating @.c@ files in this directory) then the build not reach+--   a stable point, which is an error - detected by running with @--lint@.+--   You should normally only call this function returning source files.+--+--   For an untracked variant see 'getDirectoryFilesIO'.+getDirectoryFiles :: FilePath -> [FilePattern] -> Action [FilePath]+getDirectoryFiles dir pat = fmap fromGetDirectoryA $ apply1 $ GetDirectoryFilesQ (dir,pat)++-- | Get the directories in a directory, not including @.@ or @..@.+--   All directories are relative to the argument directory.+--   The result itself is tracked as a dependency, but the directories in the result are not.+--   If the list of directories changes in subsequent builds any rule calling it will rerun.++--   The rules about creating entries described in 'getDirectoryFiles' also apply here.+--+-- > getDirectoryDirs "/Users"+-- >    -- Return all directories in the /Users directory+-- >    -- e.g. ["Emily","Henry","Neil"]+getDirectoryDirs :: FilePath -> Action [FilePath]+getDirectoryDirs = fmap fromGetDirectoryA . apply1 . GetDirectoryDirsQ+++---------------------------------------------------------------------+-- IO ROUTINES++getDirectoryContentsIO :: FilePath -> IO [FilePath]+-- getDirectoryContents "" is equivalent to getDirectoryContents "." on Windows,+-- but raises an error on Linux. We smooth out the difference.+getDirectoryContentsIO dir = fmap (sort . filter (not . all (== '.'))) $ IO.getDirectoryContents $ if dir == "" then "." else dir+++getDirectoryDirsIO :: FilePath -> IO [FilePath]+getDirectoryDirsIO dir = filterM f =<< getDirectoryContentsIO dir+    where f x = IO.doesDirectoryExist $ dir </> x+++-- | A version of 'getDirectoryFiles' that is in IO, and thus untracked.+getDirectoryFilesIO :: FilePath -> [FilePattern] -> IO [FilePath]+-- Known infelicity: on Windows, if you search for "foo", but have the file "FOO",+-- it will match if on its own, or not if it is paired with "*", since that forces+-- a full directory scan, and then it uses Haskell equality (case sensitive)+getDirectoryFilesIO root pat = f "" $ snd $ walk pat+    where+        -- Even after we know they are there because we called contents, we still have to check they are directories/files+        -- as required+        f dir (Walk op) = f dir . WalkTo . op =<< getDirectoryContentsIO (root </> dir)+        f dir (WalkTo (files, dirs)) = do+            files <- filterM (IO.doesFileExist . (root </>)) $ map (dir </>) files+            dirs <- concatMapM (uncurry f) =<< filterM (IO.doesDirectoryExist . (root </>) . fst) (map (first (dir </>)) dirs)+            pure $ files ++ dirs+++---------------------------------------------------------------------+-- REMOVE UTILITIES++-- | Remove all files and directories that match any of the patterns within a directory.+--   Some examples:+--+-- @+-- 'removeFiles' \"output\" [\"\/\/*\"]        -- delete everything inside \'output\'+-- 'removeFiles' \"output\" [\"\/\/\"]         -- delete \'output\' itself+-- 'removeFiles' \".\" [\"\/\/*.hi\",\"\/\/*.o\"] -- delete all \'.hi\' and \'.o\' files+-- @+--+--   If the argument directory is missing no error is raised.+--   This function will follow symlinks, so should be used with care.+--+--   This function is often useful when writing a @clean@ action for your build system,+--   often as a 'phony' rule.+removeFiles :: FilePath -> [FilePattern] -> IO ()+removeFiles dir pat =+    whenM (IO.doesDirectoryExist dir) $ do+        let (b,w) = walk pat+        if b then removeDir dir else f dir w+    where+        f dir (Walk op) = f dir . WalkTo . op =<< getDirectoryContentsIO dir+        f dir (WalkTo (files, dirs)) = do+            forM_ files $ \fil ->+                tryIO $ removeItem $ dir </> fil+            let done = Set.fromList files+            forM_ (filter (not . flip Set.member done . fst) dirs) $ \(d,w) -> do+                let dir2 = dir </> d+                whenM (IO.doesDirectoryExist dir2) $ f dir2 w++        removeItem :: FilePath -> IO ()+        removeItem x = IO.removeFile x `catchIO` \_ -> removeDir x++        -- In newer GHC's removeDirectoryRecursive is probably better, but doesn't follow+        -- symlinks, so it's got different behaviour+        removeDir :: FilePath -> IO ()+        removeDir x = do+            mapM_ (removeItem . (x </>)) =<< getDirectoryContentsIO x+            IO.removeDirectory x+++-- | Remove files, like 'removeFiles', but executed after the build completes successfully using 'runAfter'.+--   Useful for implementing @clean@ actions that delete files Shake may have open for building, e.g. 'shakeFiles'.+--   Where possible, delete the files as a normal part of the build, e.g. using @'liftIO' $ 'removeFiles' dir pats@.+removeFilesAfter :: FilePath -> [FilePattern] -> Action ()+removeFilesAfter a b = do+    putVerbose $ "Will remove " ++ unwords b ++ " from " ++ a+    runAfter $ removeFiles a b
+ src/Development/Shake/Internal/Rules/File.hs view
@@ -0,0 +1,614 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable, ScopedTypeVariables, NamedFieldPuns #-}+{-# LANGUAGE ViewPatterns, RecordWildCards, FlexibleInstances, TypeFamilies, ConstraintKinds #-}++module Development.Shake.Internal.Rules.File(+    need, needHasChanged, needBS, needed, neededBS, want,+    trackRead, trackWrite, trackAllow, produces,+    defaultRuleFile,+    (%>), (|%>), (?>), phony, (~>), phonys,+    resultHasChanged,+    -- * Internal only+    FileQ(..), FileA(..), fileStoredValue, fileEqualValue, EqualCost(..), fileForward+    ) where++import Control.Monad.Extra+import Control.Monad.IO.Class+import Data.Typeable+import Data.List+import Data.Maybe+import qualified Data.ByteString.Char8 as BS+import qualified Data.HashSet as Set+import Foreign.Storable+import Data.Word+import Data.Monoid+import General.Binary+import General.Extra++import Development.Shake.Internal.Core.Types+import Development.Shake.Internal.Core.Rules+import Development.Shake.Internal.Core.Build+import Development.Shake.Internal.Core.Action+import Development.Shake.Internal.FileName+import Development.Shake.Internal.Rules.Rerun+import Development.Shake.Classes+import Development.Shake.FilePath(toStandard)+import Development.Shake.Internal.FilePattern+import Development.Shake.Internal.FileInfo+import Development.Shake.Internal.Options+import Development.Shake.Internal.Errors++import System.FilePath(takeDirectory) -- important that this is the system local filepath, or wrong slashes go wrong+import System.IO.Unsafe(unsafeInterleaveIO)++import Prelude+++infix 1 %>, ?>, |%>, ~>++---------------------------------------------------------------------+-- TYPES++type instance RuleResult FileQ = FileR++-- | The unique key we use to index File rules, to avoid name clashes.+newtype FileQ = FileQ {fromFileQ :: FileName}+    deriving (Typeable,Eq,Hashable,Binary,BinaryEx,NFData)++-- | Raw information about a file.+data FileA = FileA {-# UNPACK #-} !ModTime {-# UNPACK #-} !FileSize FileHash+    deriving (Typeable)++-- | Result of a File rule, may contain raw file information and whether the rule did run this build+data FileR = FileR { answer :: !(Maybe FileA) -- ^ Raw information about the file built by this rule.+                                              --   Set to 'Nothing' for 'phony' files.+                   , useLint :: !Bool       -- ^ Should we lint the resulting file+                   }+    deriving (Typeable)++-- | The types of file rule that occur.+data Mode+    = ModePhony (Action ()) -- ^ An action with no file value+    | ModeDirect (Action ()) -- ^ An action that produces this file+    | ModeForward (Action (Maybe FileA)) -- ^ An action that looks up a file someone else produced++-- | The results of the various 'Mode' rules.+data Answer+    = AnswerPhony+    | AnswerDirect Ver FileA+    | AnswerForward Ver FileA++-- | The file rules we use, first is the name (as pretty as you can get).+data FileRule = FileRule String (FilePath -> Maybe Mode)+    deriving Typeable+++---------------------------------------------------------------------+-- INSTANCES++instance Show FileQ where show (FileQ x) = fileNameToString x++instance BinaryEx [FileQ] where+    putEx = putEx . map fromFileQ+    getEx = map FileQ . getEx++instance NFData FileA where+    rnf (FileA a b c) = rnf a `seq` rnf b `seq` rnf c++instance NFData FileR where+    rnf (FileR a b) = rnf a `seq` rnf b++instance Show FileA where+    show (FileA m s h) = "File {mod=" ++ show m ++ ",size=" ++ show s ++ ",digest=" ++ show h ++ "}"++instance Show FileR where+    show FileR{..} = show answer++instance Storable FileA where+    sizeOf _ = 4 * 3 -- 4 Word32's+    alignment _ = alignment (undefined :: ModTime)+    peekByteOff p i = FileA <$> peekByteOff p i <*> peekByteOff p (i+4) <*> peekByteOff p (i+8)+    pokeByteOff p i (FileA a b c) = pokeByteOff p i a >> pokeByteOff p (i+4) b >> pokeByteOff p (i+8) c++instance BinaryEx FileA where+    putEx = putExStorable+    getEx = getExStorable++instance BinaryEx [FileA] where+    putEx = putExStorableList+    getEx = getExStorableList++fromAnswer :: Answer -> Maybe FileA+fromAnswer AnswerPhony = Nothing+fromAnswer (AnswerDirect _ x) = Just x+fromAnswer (AnswerForward _ x) = Just x++instance BinaryEx Answer where+    putEx AnswerPhony = mempty+    putEx (AnswerDirect ver x) = putExStorable ver <> putEx x+    putEx (AnswerForward ver x) = putEx (0 :: Word8) <> putExStorable ver <> putEx x++    getEx x = case BS.length x of+        0 -> AnswerPhony+        i -> if i == sz then f AnswerDirect x else f AnswerForward $ BS.tail x+        where+            sz = sizeOf (undefined :: Ver) + sizeOf (undefined :: FileA)+            f ctor x = let (a,b) = binarySplit x in ctor a $ getEx b+++---------------------------------------------------------------------+-- FILE CHECK QUERIES++-- | An equality check and a cost.+data EqualCost+    = EqualCheap -- ^ The equality check was cheap.+    | EqualExpensive -- ^ The equality check was expensive, as the results are not trivially equal.+    | NotEqual -- ^ The values are not equal.+      deriving (Eq,Ord,Show,Read,Typeable,Enum,Bounded)++fileStoredValue :: ShakeOptions -> FileQ -> IO (Maybe FileA)+fileStoredValue ShakeOptions{shakeChange=c, shakeNeedDirectory=allowDir} (FileQ x) = do+    res <- getFileInfo allowDir x+    case res of+        Nothing -> pure Nothing+        Just (time,size) | c == ChangeModtime -> pure $ Just $ FileA time size noFileHash+        Just (time,size) -> do+            hash <- unsafeInterleaveIO $ getFileHash x+            pure $ Just $ FileA time size hash+++fileEqualValue :: ShakeOptions -> FileA -> FileA -> EqualCost+fileEqualValue ShakeOptions{shakeChange=c} (FileA x1 x2 x3) (FileA y1 y2 y3) = case c of+    ChangeModtime -> bool $ x1 == y1+    ChangeDigest -> bool $ x2 == y2 && x3 == y3+    ChangeModtimeOrDigest -> bool $ x1 == y1 && x2 == y2 && x3 == y3+    _ | x1 == y1 -> EqualCheap+      | x2 == y2 && x3 == y3 -> EqualExpensive+      | otherwise -> NotEqual+    where bool b = if b then EqualCheap else NotEqual+++-- | Arguments: options; is the file an input; a message for failure if the file does not exist; filename+storedValueError :: ShakeOptions -> Bool -> String -> FileQ -> IO (Maybe FileA)+{-+storedValueError opts False msg x | False && not (shakeOutputCheck opts) = do+    when (shakeCreationCheck opts) $ do+        whenM (isNothing <$> (storedValue opts x :: IO (Maybe FileA))) $ error $ msg ++ "\n  " ++ unpackU (fromFileQ x)+    pure $ FileA fileInfoEq fileInfoEq fileInfoEq+-}+storedValueError opts input msg x = maybe def Just <$> fileStoredValue opts2 x+    where def = if shakeCreationCheck opts || input then error err else Nothing+          err = msg ++ "\n  " ++ fileNameToString (fromFileQ x)+          opts2 = if not input && shakeChange opts == ChangeModtimeAndDigestInput then opts{shakeChange=ChangeModtime} else opts+++---------------------------------------------------------------------+-- THE DEFAULT RULE++defaultRuleFile :: Rules ()+defaultRuleFile = do+    opts@ShakeOptions{..} <- getShakeOptionsRules+    -- A rule from FileQ to (Maybe FileA). The result value is only useful for linting.+    addBuiltinRuleEx (ruleLint opts) (ruleIdentity opts) (ruleRun opts $ shakeRebuildApply opts)++ruleLint :: ShakeOptions -> BuiltinLint FileQ FileR+ruleLint opts k (FileR (Just v) True) = do+    now <- fileStoredValue opts k+    pure $ case now of+        Nothing -> Just "<missing>"+        Just now | fileEqualValue opts v now == EqualCheap -> Nothing+                 | otherwise -> Just $ show now+ruleLint _ _ _ = pure Nothing++ruleIdentity :: ShakeOptions -> BuiltinIdentity FileQ FileR+ruleIdentity opts | shakeChange opts == ChangeModtime = throwImpure errorNoHash+ruleIdentity _ = \k v -> case answer v of+    Just (FileA _ size hash) -> Just $ runBuilder $ putExStorable size <> putExStorable hash+    Nothing -> Nothing++ruleRun :: ShakeOptions -> (FilePath -> Rebuild) -> BuiltinRun FileQ FileR+ruleRun opts@ShakeOptions{..} rebuildFlags o@(FileQ (fileNameToString -> xStr)) oldBin@(fmap getEx -> (old :: Maybe Answer)) mode = do+    -- for One, rebuild makes perfect sense+    -- for Forward, we expect the child will have already rebuilt - Rebuild just lets us deal with code changes+    -- for Phony, it doesn't make that much sense, but probably isn't harmful?+    let r = rebuildFlags xStr++    (ruleVer, ruleAct, ruleErr) <- getUserRuleInternal o (\(FileRule s _) -> Just s) $ \(FileRule _ f) -> f xStr+    let verEq v = Just v == ruleVer || case ruleAct of [] -> v == Ver 0; [(v2,_)] -> v == Ver v2; _ -> False+    let rebuild = do+            putWhen Verbose $ "# " ++ show o+            case ruleAct of+                [] -> rebuildWith Nothing+                [x] -> rebuildWith $ Just x+                _ -> throwM ruleErr++    case old of+        _ | r == RebuildNow -> rebuild+        _ | r == RebuildLater -> case old of+            Just _ ->+                -- ignoring the currently stored value, which may trigger lint has changed+                -- so disable lint on this file+                unLint <$> retOld ChangedNothing+            Nothing -> do+                -- i don't have a previous value, so assume this is a source node, and mark rebuild in future+                now <- liftIO $ fileStoredValue opts o+                case now of+                    Nothing -> rebuild+                    Just now -> do alwaysRerun; retNew ChangedStore $ AnswerDirect (Ver 0) now+        {-+        _ | r == RebuildNever -> do+            now <- liftIO $ fileStoredValue opts o+            case now of+                Nothing -> rebuild+                Just now -> do+                    let diff | Just (AnswerDirect old) <- old, fileEqualValue opts old now /= NotEqual = ChangedRecomputeSame+                                | otherwise = ChangedRecomputeDiff+                    retNew diff $ AnswerDirect now+        -}+        Just (AnswerDirect ver old) | mode == RunDependenciesSame, verEq ver -> do+            now <- liftIO $ fileStoredValue opts o+            let noHash (FileA _ _ x) = isNoFileHash x+            case now of+                Nothing -> rebuild+                Just now -> case fileEqualValue opts old now of+                    NotEqual ->+                        rebuild+                    -- if our last build used no file hashing, but this build should, then we must refresh the hash+                    EqualCheap | if noHash old then shakeChange == ChangeModtimeAndDigestInput || noHash now else True ->+                        retOld ChangedNothing+                    _ ->+                        retNew ChangedStore $ AnswerDirect ver now+        Just (AnswerForward ver _) | verEq ver, mode == RunDependenciesSame -> retOld ChangedNothing+        _ -> rebuild+    where+        -- no need to lint check forward files+        -- but more than that, it goes wrong if you do, see #427+        fileR (AnswerDirect _ x) = FileR (Just x) True+        fileR (AnswerForward _ x) = FileR (Just x) False+        fileR AnswerPhony = FileR Nothing False+        unLint (RunResult a b c) = RunResult a b c{useLint = False}++        retNew :: RunChanged -> Answer -> Action (RunResult FileR)+        retNew c v = pure $ RunResult c (runBuilder $ putEx v) $ fileR v++        retOld :: RunChanged -> Action (RunResult FileR)+        retOld c = pure $ RunResult c (fromJust oldBin) $ fileR (fromJust old)++        -- actually run the rebuild+        rebuildWith act = do+            let answer ctor new = do+                    let b = case () of+                                _ | Just old <- old+                                    , Just old <- fromAnswer old+                                    , fileEqualValue opts old new /= NotEqual -> ChangedRecomputeSame+                                _ -> ChangedRecomputeDiff+                    retNew b $ ctor new+            case act of+                Nothing -> do+                    new <- liftIO $ storedValueError opts True "Error, file does not exist and no rule available:" o+                    answer (AnswerDirect $ Ver 0)  $ fromJust new+                Just (ver, ModeForward act) -> do+                    new <- act+                    case new of+                        Nothing -> do+                            -- Not 100% sure how you get here, but I think it involves RebuildLater and multi-file rules+                            historyDisable+                            retNew ChangedRecomputeDiff AnswerPhony+                        Just new -> answer (AnswerForward $ Ver ver) new+                Just (ver, ModeDirect act) -> do+                    cache <- historyLoad ver+                    case cache of+                        Just encodedHash -> do+                            Just (FileA mod size _) <- liftIO $ storedValueError opts False "Error, restored the rule but did not produce file:" o+                            answer (AnswerDirect $ Ver ver) $ FileA mod size $ getExStorable encodedHash+                        Nothing -> do+                            act+                            new <- liftIO $ storedValueError opts False "Error, rule finished running but did not produce file:" o+                            case new of+                                Nothing -> do+                                    -- rule ran, but didn't compute an answer, because shakeCreationCheck=False+                                    -- I think it should probably not return phony, but return a different valid-but-no-file+                                    -- but it's just too rare to bother+                                    historyDisable+                                    retNew ChangedRecomputeDiff AnswerPhony+                                Just new@(FileA _ _ fileHash) -> do+                                    producesUnchecked [xStr]+                                    res <- answer (AnswerDirect $ Ver ver) new+                                    historySave ver $ runBuilder $+                                        if isNoFileHash fileHash then throwImpure errorNoHash else putExStorable fileHash+                                    pure res+                Just (_, ModePhony act) -> do+                    -- See #523 and #524+                    -- Shake runs the dependencies first, but stops when one has changed.+                    -- We don't want to run the existing deps first if someone changes the build system,+                    -- so insert a fake dependency that cuts the process dead.+                    alwaysRerun+                    act+                    retNew ChangedRecomputeDiff AnswerPhony+++apply_ :: Partial => (a -> FileName) -> [a] -> Action [FileR]+apply_ f = apply . map (FileQ . f)+++-- | Has a file changed. This function will only give the correct answer if called in the rule+--   producing the file, /before/ the rule has modified the file in question.+--   Best avoided, but sometimes necessary in conjunction with 'needHasChanged' to cause rebuilds+--   to happen if the result is deleted or modified.+resultHasChanged :: FilePath -> Action Bool+resultHasChanged file = do+    let filename = FileQ $ fileNameFromString file+    res <- getDatabaseValue filename+    old<- pure $ case result <$> res of+        Nothing -> Nothing+        Just (Left bs) -> fromAnswer $ getEx bs+        Just (Right v) -> answer v+    case old of+        Nothing -> pure True+        Just old -> do+            opts <- getShakeOptions+            new <- liftIO $ fileStoredValue opts filename+            pure $ case new of+                Nothing -> True+                Just new -> fileEqualValue opts old new == NotEqual+++---------------------------------------------------------------------+-- OPTIONS ON TOP++-- | Internal method for adding forwarding actions+fileForward :: String -> (FilePath -> Maybe (Action (Maybe FileA))) -> Rules ()+fileForward help act = addUserRule $ FileRule help $ fmap ModeForward . act+++-- | Add a dependency on the file arguments, ensuring they are built before continuing.+--   The file arguments may be built in parallel, in any order. This function is particularly+--   necessary when calling 'Development.Shake.cmd' or 'Development.Shake.command'. As an example:+--+-- @+-- \"\/\/*.rot13\" '%>' \\out -> do+--     let src = 'Development.Shake.FilePath.dropExtension' out+--     'need' [src]+--     'Development.Shake.cmd' \"rot13\" [src] \"-o\" [out]+-- @+--+--   Note that the following expressions are all equivalent. @foo@ and @bar@ are built in parallel:+--+--   - @need [foo,bar]@+--   - @need [foo] '*>' need [bar]@+--   - @need [foo] '>>' need [bar]@+--+--   In this situation, @need [foo, bar]@ is preferable, since the parallelism is the most obvious.+--+--   This function should not be called with wildcards (e.g. @*.txt@ - use 'getDirectoryFiles' to expand them),+--   environment variables (e.g. @$HOME@ - use 'getEnv' to expand them) or directories (directories cannot be+--   tracked directly - track files within the directory instead).+need :: Partial => [FilePath] -> Action ()+need = withFrozenCallStack $ void . apply_ fileNameFromString+++-- | Like 'need' but returns a list of rebuilt dependencies since the calling rule last built successfully.+--+--   The following example writes a list of changed dependencies to a file as its action.+--+-- @+-- \"target\" '%>' \\out -> do+--       let sourceList = [\"source1\", \"source2\"]+--       rebuildList <- 'needHasChanged' sourceList+--       'Development.Shake.writeFileLines' out rebuildList+-- @+--+--   This function can be used to alter the action depending on which dependency needed+--   to be rebuild.+--+--   Note that a rule can be run even if no dependency has changed, for example+--   because of 'shakeRebuild' or because the target has changed or been deleted.+--   To detect the latter case you may wish to use 'resultHasChanged'.+needHasChanged :: Partial => [FilePath] -> Action [FilePath]+needHasChanged paths = withFrozenCallStack $ do+    apply_ fileNameFromString paths+    self <- getCurrentKey+    selfVal <- case self of+        Nothing -> pure Nothing+        Just self -> getDatabaseValueGeneric self+    case selfVal of+        Nothing -> pure paths -- never build before or not a key, so everything has changed+        Just selfVal -> flip filterM paths $ \path -> do+            pathVal <- getDatabaseValue (FileQ $ fileNameFromString path)+            pure $ case pathVal of+                Just pathVal | changed pathVal > built selfVal -> True+                _ -> False+++needBS :: Partial => [BS.ByteString] -> Action ()+needBS = withFrozenCallStack $ void . apply_ fileNameFromByteString++-- | Like 'need', but if 'shakeLint' is set, check that the file does not rebuild.+--   Used for adding dependencies on files that have already been used in this rule.+needed :: Partial => [FilePath] -> Action ()+needed xs = withFrozenCallStack $ do+    opts <- getShakeOptions+    if isNothing $ shakeLint opts then need xs else neededCheck $ map fileNameFromString xs+++neededBS :: Partial => [BS.ByteString] -> Action ()+neededBS xs = withFrozenCallStack $ do+    opts <- getShakeOptions+    if isNothing $ shakeLint opts then needBS xs else neededCheck $ map fileNameFromByteString xs+++neededCheck :: Partial => [FileName] -> Action ()+neededCheck xs = withFrozenCallStack $ do+    opts <- getShakeOptions+    pre <- liftIO $ mapM (fileStoredValue opts . FileQ) xs+    post <- apply_ id xs+    let bad = [ (x, if isJust a then "File change" else "File created")+              | (x, a, FileR (Just b) _) <- zip3 xs pre post, maybe NotEqual (\a -> fileEqualValue opts a b) a == NotEqual]+    case bad of+        [] -> pure ()+        (file,msg):_ -> throwM $ errorStructured+            "Lint checking error - 'needed' file required rebuilding"+            [("File", Just $ fileNameToString file)+            ,("Error",Just msg)]+            ""+++-- Either trackRead or trackWrite+track :: ([FileQ] -> Action ()) -> [FilePath] -> Action ()+track tracker xs = do+    ShakeOptions{shakeLintIgnore} <- getShakeOptions+    let ignore = (?==*) shakeLintIgnore+    let ys = filter (not . ignore) xs+    when (ys /= []) $+        tracker $ map (FileQ . fileNameFromString) ys+++-- | Track that a file was read by the action preceding it. If 'shakeLint' is activated+--   then these files must be dependencies of this rule. Calls to 'trackRead' are+--   automatically inserted in 'LintFSATrace' mode.+trackRead :: [FilePath] -> Action ()+trackRead = track lintTrackRead+++-- | Track that a file was written by the action preceding it. If 'shakeLint' is activated+--   then these files must either be the target of this rule, or never referred to by the build system.+--   Calls to 'trackWrite' are automatically inserted in 'LintFSATrace' mode.+trackWrite :: [FilePath] -> Action ()+trackWrite = track lintTrackWrite++-- | Allow accessing a file in this rule, ignoring any subsequent 'trackRead' \/ 'trackWrite' calls matching+--   the pattern.+trackAllow :: [FilePattern] -> Action ()+trackAllow ps = do+    let ignore = (?==*) ps+    lintTrackAllow $ \(FileQ x) -> ignore $ fileNameToString x+++-- | This rule builds the following files, in addition to any defined by its target.+--   At the end of the rule these files must have been written.+--   These files must /not/ be tracked as part of the build system - two rules cannot produce+--   the same file and you cannot 'need' the files it produces.+produces :: [FilePath] -> Action ()+produces xs = do+    producesChecked xs+    trackWrite xs+++-- | Require that the argument files are built by the rules, used to specify the target.+--+-- @+-- main = 'Development.Shake.shake' 'shakeOptions' $ do+--    'want' [\"Main.exe\"]+--    ...+-- @+--+--   This program will build @Main.exe@, given sufficient rules. All arguments to all 'want' calls+--   may be built in parallel, in any order.+--+--   This function is defined in terms of 'action' and 'need', use 'action' if you need more complex+--   targets than 'want' allows.+want :: Partial => [FilePath] -> Rules ()+want [] = pure ()+want xs = withFrozenCallStack $ action $ need xs+++root :: String -> (FilePath -> Bool) -> (FilePath -> Action ()) -> Rules ()+root help test act = addUserRule $ FileRule help $ \x -> if not $ test x then Nothing else Just $ ModeDirect $ do+    liftIO $ createDirectoryRecursive $ takeDirectory x+    act x+++-- | Declare a Make-style phony action.  A phony target does not name+--   a file (despite living in the same namespace as file rules);+--   rather, it names some action to be executed when explicitly+--   requested.  You can demand 'phony' rules using 'want'. (And 'need',+--   although that's not recommended.)+--+--   Phony actions are intended to define recipes that can be executed+--   by the user. If you 'need' a phony action in a rule then every+--   execution where that rule is required will rerun both the rule and+--   the phony action.  However, note that phony actions are never+--   executed more than once in a single build run.+--+--   In make, the @.PHONY@ attribute on non-file-producing rules has a+--   similar effect.  However, while in make it is acceptable to omit+--   the @.PHONY@ attribute as long as you don't create the file in+--   question, a Shake rule which behaves this way will fail lint.+--   For file-producing rules which should be+--   rerun every execution of Shake, see 'Development.Shake.alwaysRerun'.+phony :: Located => String -> Action () -> Rules ()+phony oname@(toStandard -> name) act = do+    addTarget oname+    addPhony ("phony " ++ show oname ++ " at " ++ callStackTop) $ \s -> if s == name then Just act else Nothing++-- | A predicate version of 'phony', return 'Just' with the 'Action' for the matching rules.+phonys :: Located => (String -> Maybe (Action ())) -> Rules ()+phonys = addPhony ("phonys at " ++ callStackTop)++-- | Infix operator alias for 'phony', for sake of consistency with normal+--   rules.+(~>) :: Located => String -> Action () -> Rules ()+(~>) oname@(toStandard -> name) act = do+    addTarget oname+    addPhony (show oname ++ " ~> at " ++ callStackTop) $ \s -> if s == name then Just act else Nothing++addPhony :: String -> (String -> Maybe (Action ())) -> Rules ()+addPhony help act = addUserRule $ FileRule help $ fmap ModePhony . act+++-- | Define a rule to build files. If the first argument returns 'True' for a given file,+--   the second argument will be used to build it. Usually '%>' is sufficient, but '?>' gives+--   additional power. For any file used by the build system, only one rule should return 'True'.+--   This function will create the directory for the result file, if necessary.+--+-- @+-- (all isUpper . 'Development.Shake.FilePath.takeBaseName') '?>' \\out -> do+--     let src = 'Development.Shake.FilePath.replaceBaseName' out $ map toLower $ takeBaseName out+--     'Development.Shake.writeFile'' out . map toUpper =<< 'Development.Shake.readFile'' src+-- @+--+--   If the 'Action' completes successfully the file is considered up-to-date, even if the file+--   has not changed.+(?>) :: Located => (FilePath -> Bool) -> (FilePath -> Action ()) -> Rules ()+(?>) test act = priority 0.5 $ root ("?> at " ++ callStackTop) test act+++-- | Define a set of patterns, and if any of them match, run the associated rule. Defined in terms of '%>'.+--   Think of it as the OR (@||@) equivalent of '%>'.+(|%>) :: Located => [FilePattern] -> (FilePath -> Action ()) -> Rules ()+(|%>) pats act = do+    mapM_ addTarget pats+    let (simp,other) = partition simple pats+    case map toStandard simp of+        [] -> pure ()+        [p] -> root help (\x -> toStandard x == p) act+        ps -> let set = Set.fromList ps in root help (flip Set.member set . toStandard) act+    unless (null other) $+        let ps = map (?==) other in priority 0.5 $ root help (\x -> any ($ x) ps) act+    where help = show pats ++ " |%> at " ++ callStackTop++-- | Define a rule that matches a 'FilePattern', see '?==' for the pattern rules.+--   Patterns with no wildcards have higher priority than those with wildcards, and no file+--   required by the system may be matched by more than one pattern at the same priority+--   (see 'priority' and 'alternatives' to modify this behaviour).+--   This function will create the directory for the result file, if necessary.+--+-- @+-- \"*.asm.o\" '%>' \\out -> do+--     let src = 'Development.Shake.FilePath.dropExtension' out+--     'need' [src]+--     'Development.Shake.cmd' \"as\" [src] \"-o\" [out]+-- @+--+--   To define a build system for multiple compiled languages, we recommend using @.asm.o@,+--   @.cpp.o@, @.hs.o@, to indicate which language produces an object file.+--   I.e., the file @foo.cpp@ produces object file @foo.cpp.o@.+--+--   Note that matching is case-sensitive, even on Windows.+--+--   If the 'Action' completes successfully the file is considered up-to-date, even if the file+--   has not changed.+(%>) :: Located => FilePattern -> (FilePath -> Action ()) -> Rules ()+(%>) test act = withFrozenCallStack $+    (if simple test then id else priority 0.5) $ do+        addTarget test+        root (show test ++ " %> at " ++ callStackTop) (test ?==) act
+ src/Development/Shake/Internal/Rules/Files.hs view
@@ -0,0 +1,249 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable, ScopedTypeVariables #-}+{-# LANGUAGE ViewPatterns, TypeFamilies, ConstraintKinds #-}++module Development.Shake.Internal.Rules.Files(+    (&?>), (&%>), defaultRuleFiles+    ) where++import Control.Monad+import Control.Monad.IO.Class+import Data.Maybe+import Data.List.Extra+import Data.Typeable+import General.Binary++import Development.Shake.Internal.Core.Action+import Development.Shake.Internal.Core.Types hiding (Result)+import Development.Shake.Internal.Core.Build+import Development.Shake.Internal.Core.Rules+import Development.Shake.Internal.Errors+import General.Extra+import Development.Shake.Internal.FileName+import Development.Shake.Classes+import Development.Shake.Internal.Rules.Rerun+import Development.Shake.Internal.Rules.File+import Development.Shake.Internal.FilePattern+import Development.Shake.FilePath+import Development.Shake.Internal.FileInfo+import Development.Shake.Internal.Options+import Data.Monoid+import Prelude+++infix 1 &?>, &%>+++type instance RuleResult FilesQ = FilesA++newtype FilesQ = FilesQ {fromFilesQ :: [FileQ]}+    deriving (Typeable,Eq,Hashable,Binary,BinaryEx,NFData)++newtype FilesA = FilesA [FileA]+    deriving (Typeable,BinaryEx,NFData)++instance Show FilesA where show (FilesA xs) = unwords $ "Files" : map (drop 5 . show) xs++instance Show FilesQ where show (FilesQ xs) = unwords $ map (wrapQuote . show) xs++data FilesRule = FilesRule String (FilesQ -> Maybe (Action FilesA))+    deriving Typeable++data Result = Result Ver FilesA++instance BinaryEx Result where+    putEx (Result v x) = putExStorable v <> putEx x+    getEx s = let (a,b) = binarySplit s in Result a $ getEx b+++filesStoredValue :: ShakeOptions -> FilesQ -> IO (Maybe FilesA)+filesStoredValue opts (FilesQ xs) = fmap FilesA . sequence <$> mapM (fileStoredValue opts) xs++filesEqualValue :: ShakeOptions -> FilesA -> FilesA -> EqualCost+filesEqualValue opts (FilesA xs) (FilesA ys)+    | length xs /= length ys = NotEqual+    | otherwise = foldr and_ EqualCheap $ zipWithExact (fileEqualValue opts) xs ys+        where and_ NotEqual _ = NotEqual+              and_ EqualCheap x = x+              and_ EqualExpensive x = if x == NotEqual then NotEqual else EqualExpensive++defaultRuleFiles :: Rules ()+defaultRuleFiles = do+    opts <- getShakeOptionsRules+    -- A rule from FilesQ to FilesA. The result value is only useful for linting.+    addBuiltinRuleEx (ruleLint opts) (ruleIdentity opts) (ruleRun opts $ shakeRebuildApply opts)++ruleLint :: ShakeOptions -> BuiltinLint FilesQ FilesA+ruleLint _ _ (FilesA []) = pure Nothing -- in the case of disabling lint+ruleLint opts k v = do+    now <- filesStoredValue opts k+    pure $ case now of+        Nothing -> Just "<missing>"+        Just now | filesEqualValue opts v now == EqualCheap -> Nothing+                 | otherwise -> Just $ show now++ruleIdentity :: ShakeOptions -> BuiltinIdentity FilesQ FilesA+ruleIdentity opts | shakeChange opts == ChangeModtime = throwImpure $ errorStructured+    "Cannot use shakeChange=ChangeModTime with shakeShare" [] ""+ruleIdentity _ = \_ (FilesA files) ->+    Just $ runBuilder $ putExList [putExStorable size <> putExStorable hash | FileA _ size hash <- files]++++ruleRun :: ShakeOptions -> (FilePath -> Rebuild) -> BuiltinRun FilesQ FilesA+ruleRun opts rebuildFlags k o@(fmap getEx -> (old :: Maybe Result)) mode = do+    let r = map (rebuildFlags . fileNameToString . fromFileQ) $ fromFilesQ k++    (ruleVer, ruleAct, ruleErr) <- getUserRuleInternal k (\(FilesRule s _) -> Just s) $ \(FilesRule _ f) -> f k+    let verEq v = Just v == ruleVer || map (Ver . fst) ruleAct == [v]+    let rebuild = do+            putWhen Verbose $ "# " ++ show k+            case ruleAct of+                [x] -> rebuildWith x+                _ -> throwM ruleErr++    case old of+        _ | RebuildNow `elem` r -> rebuild+        _ | RebuildLater `elem` r -> case old of+            Just _ ->+                -- ignoring the currently stored value, which may trigger lint has changed+                -- so disable lint on this file+                pure $ RunResult ChangedNothing (fromJust o) $ FilesA []+            Nothing -> do+                -- i don't have a previous value, so assume this is a source node, and mark rebuild in future+                now <- liftIO $ filesStoredValue opts k+                case now of+                    Nothing -> rebuild+                    Just now -> do alwaysRerun; pure $ RunResult ChangedStore (runBuilder $ putEx $ Result (Ver 0) now) now+        Just (Result ver old) | mode == RunDependenciesSame, verEq ver -> do+            v <- liftIO $ filesStoredValue opts k+            case v of+                Just v -> case filesEqualValue opts old v of+                    NotEqual -> rebuild+                    -- See #810, important we pass old (which can be cheaply evaluated)+                    -- and not v, which might have some lazily-evaluated file hashes in+                    EqualCheap -> pure $ RunResult ChangedNothing (fromJust o) old+                    EqualExpensive -> pure $ RunResult ChangedStore (runBuilder $ putEx $ Result ver v) v+                Nothing -> rebuild+        _ -> rebuild+    where+        rebuildWith (ver, act) = do+            cache <- historyLoad ver+            v <- case cache of+                Just res ->+                    fmap FilesA $ forM (zipExact (getExList res) (fromFilesQ k)) $ \(bin, file) -> do+                        Just (FileA mod size _) <- liftIO $ fileStoredValue opts file+                        pure $ FileA mod size $ getExStorable bin+                Nothing -> do+                    FilesA v <- act+                    producesUnchecked $ map (fileNameToString . fromFileQ) $ fromFilesQ k+                    historySave ver $ runBuilder $ putExList+                        [if isNoFileHash hash then throwImpure errorNoHash else putExStorable hash | FileA _ _ hash <- v]+                    pure $ FilesA v+            let c | Just (Result _ old) <- old, filesEqualValue opts old v /= NotEqual = ChangedRecomputeSame+                  | otherwise = ChangedRecomputeDiff+            pure $ RunResult c (runBuilder $ putEx $ Result (Ver ver) v) v++++-- | Define a rule for building multiple files at the same time.+--   Think of it as the AND (@&&@) equivalent of '%>'.+--   As an example, a single invocation of GHC produces both @.hi@ and @.o@ files:+--+-- @+-- [\"*.o\",\"*.hi\"] '&%>' \\[o,hi] -> do+--     let hs = o 'Development.Shake.FilePath.-<.>' \"hs\"+--     'Development.Shake.need' ... -- all files the .hs import+--     'Development.Shake.cmd' \"ghc -c\" [hs]+-- @+--+--   However, in practice, it's usually easier to define rules with '%>' and make the @.hi@ depend+--   on the @.o@. When defining rules that build multiple files, all the 'FilePattern' values must+--   have the same sequence of @\/\/@ and @*@ wildcards in the same order.+--   This function will create directories for the result files, if necessary.+(&%>) :: Located => [FilePattern] -> ([FilePath] -> Action ()) -> Rules ()+[p] &%> act = withFrozenCallStack $ p %> act . pure+ps &%> act+    | not $ compatible ps = error $ unlines $+        "All patterns to &%> must have the same number and position of ** and * wildcards" :+        ["* " ++ p ++ (if compatible [p, headErr ps] then "" else " (incompatible)") | p <- ps]+    | otherwise = withFrozenCallStack $ do+        forM_ (zipFrom 0 ps) $ \(i,p) ->+            (if simple p then id else priority 0.5) $+                fileForward (show ps ++ " &%> at " ++ callStackTop) $ let op = (p ?==) in \file -> if not $ op file then Nothing else Just $ do+                    FilesA res <- apply1 $ FilesQ $ map (FileQ . fileNameFromString . substitute (extract p file)) ps+                    pure $ if null res then Nothing else Just $ res !! i+        (if all simple ps then id else priority 0.5) $ do+            mapM_ addTarget ps+            addUserRule $ FilesRule (show ps ++ " &%> " ++ callStackTop) $ \(FilesQ xs_) -> let xs = map (fileNameToString . fromFileQ) xs_ in+                if not $ length xs == length ps && and (zipWithExact (?==) ps xs) then Nothing else Just $ do+                    liftIO $ mapM_ createDirectoryRecursive $ nubOrd $ map takeDirectory xs+                    trackAllow xs+                    act xs+                    getFileTimes "&%>" xs_+++-- | Define a rule for building multiple files at the same time, a more powerful+--   and more dangerous version of '&%>'. Think of it as the AND (@&&@) equivalent of '?>'.+--+--   Given an application @test &?> ...@, @test@ should return @Just@ if the rule applies, and should+--   return the list of files that will be produced. This list /must/ include the file passed as an argument and should+--   obey the invariant:+--+-- > forAll $ \x ys -> test x == Just ys ==> x `elem` ys && all ((== Just ys) . test) ys+--+--   Intuitively, the function defines a set partitioning, mapping each element to the partition that contains it.+--   As an example of a function satisfying the invariant:+--+-- @+-- test x | 'Development.Shake.FilePath.takeExtension' x \`elem\` [\".hi\",\".o\"]+--        = Just ['Development.Shake.FilePath.dropExtension' x 'Development.Shake.FilePath.<.>' \"hi\", 'Development.Shake.FilePath.dropExtension' x 'Development.Shake.FilePath.<.>' \"o\"]+-- test _ = Nothing+-- @+--+--   Regardless of whether @Foo.hi@ or @Foo.o@ is passed, the function always returns @[Foo.hi, Foo.o]@.+(&?>) :: Located => (FilePath -> Maybe [FilePath]) -> ([FilePath] -> Action ()) -> Rules ()+(&?>) test act = priority 0.5 $ do+    let inputOutput suf inp out =+            ["Input" ++ suf ++ ":", "  " ++ inp] +++            ["Output" ++ suf ++ ":"] ++ map ("  "++) out+    let normTest = fmap (map $ toStandard . normaliseEx) . test+    let checkedTest x = case normTest x of+            Nothing -> Nothing+            Just ys | x `notElem` ys -> error $ unlines $+                "Invariant broken in &?>, did not pure the input (after normalisation)." :+                inputOutput "" x ys+            Just ys | bad:_ <- filter ((/= Just ys) . normTest) ys -> error $ unlines $+                ["Invariant broken in &?>, not equalValue for all arguments (after normalisation)."] +++                inputOutput "1" x ys +++                inputOutput "2" bad (fromMaybe ["Nothing"] $ normTest bad)+            Just ys -> Just ys++    fileForward ("&?> at " ++ callStackTop) $ \x -> case checkedTest x of+        Nothing -> Nothing+        Just ys -> Just $ do+            FilesA res <- apply1 $ FilesQ $ map (FileQ . fileNameFromString) ys+            pure $ if null res then Nothing else Just $ res !! fromJust (elemIndex x ys)++    addUserRule $ FilesRule ("&?> " ++ callStackTop) $ \(FilesQ xs_) -> let xs@(x:_) = map (fileNameToString . fromFileQ) xs_ in+        case checkedTest x of+            Just ys | ys == xs -> Just $ do+                liftIO $ mapM_ createDirectoryRecursive $ nubOrd $ map takeDirectory xs+                act xs+                getFileTimes "&?>" xs_+            Just ys -> error $ "Error, &?> is incompatible with " ++ show xs ++ " vs " ++ show ys+            Nothing -> Nothing+++getFileTimes :: String -> [FileQ] -> Action FilesA+getFileTimes name xs = do+    opts <- getShakeOptions+    let opts2 = if shakeChange opts == ChangeModtimeAndDigestInput then opts{shakeChange=ChangeModtime} else opts+    ys <- liftIO $ mapM (fileStoredValue opts2) xs+    case sequence ys of+        Just ys -> pure $ FilesA ys+        Nothing | not $ shakeCreationCheck opts -> pure $ FilesA []+        Nothing -> do+            let missing = length $ filter isNothing ys+            error $ "Error, " ++ name ++ " rule failed to produce " ++ show missing +++                    " file" ++ (if missing == 1 then "" else "s") ++ " (out of " ++ show (length xs) ++ ")" +++                    concat ["\n  " ++ fileNameToString x ++ if isNothing y then " - MISSING" else "" | (FileQ x,y) <- zipExact xs ys]
+ src/Development/Shake/Internal/Rules/Oracle.hs view
@@ -0,0 +1,163 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable, ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies, TypeOperators, ConstraintKinds #-}++module Development.Shake.Internal.Rules.Oracle(+    addOracle, addOracleCache, addOracleHash,+    askOracle, askOracles+    ) where++import Development.Shake.Internal.Core.Types+import Development.Shake.Internal.Core.Rules+import Development.Shake.Internal.Options+import Development.Shake.Internal.Core.Build+import Development.Shake.Internal.Value+import Development.Shake.Classes+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS+import Control.Monad+import Data.Binary+import General.Binary+import General.Extra+++-- Use short type names, since the names appear in the Haddock, and are too long if they are in full+newtype OracleQ question = OracleQ question+    deriving (Show,Typeable,Eq,Hashable,Binary,NFData)+newtype OracleA answer = OracleA answer+    deriving (Show,Typeable,Eq,Hashable,Binary,NFData)++fromOracleA :: OracleA a -> a+fromOracleA (OracleA x) = x++type instance RuleResult (OracleQ a) = OracleA (RuleResult a)++data Flavor = Norm | Cache | Hash deriving Eq++addOracleFlavor :: (Located, RuleResult q ~ a, ShakeValue q, ShakeValue a) => Flavor -> (q -> Action a) -> Rules (q -> Action a)+addOracleFlavor flavor act = do+        -- rebuild is automatic for oracles, skip just means we don't rebuild+        opts <- getShakeOptionsRules+        let skip = shakeRebuildApply opts "" == RebuildLater++        addBuiltinRule noLint (\_ v -> Just $ runBuilder $ putEx $ hash v) $ \(OracleQ q) old mode -> case old of+            Just old | (flavor /= Hash && skip) || (flavor == Cache && mode == RunDependenciesSame) ->+                pure $ RunResult ChangedNothing old $ decode' old+            _ -> do+                -- can only use cmpHash if flavor == Hash+                let cmpValue new = if fmap decode' old == Just new then ChangedRecomputeSame else ChangedRecomputeDiff+                let cmpHash newHash = if old == Just newHash then ChangedRecomputeSame else ChangedRecomputeDiff++                cache <- if flavor == Cache then historyLoad 0 else pure Nothing+                case cache of+                    Just newEncode -> do+                        let new = decode' newEncode+                        pure $ RunResult (cmpValue new) newEncode new+                    Nothing -> do+                        new <- OracleA <$> act q+                        let newHash = encodeHash new+                        let newEncode = encode' new+                        when (flavor == Cache) $+                            historySave 0 newEncode+                        pure $+                            if flavor == Hash+                                then RunResult (cmpHash newHash) newHash new+                                else RunResult (cmpValue new) newEncode new+        pure askOracle+    where+        encodeHash :: Hashable a => a -> BS.ByteString+        encodeHash = runBuilder . putEx . hash++        encode' :: Binary a => a -> BS.ByteString+        encode' = BS.concat . LBS.toChunks . encode++        decode' :: Binary a => BS.ByteString -> a+        decode' = decode . LBS.fromChunks . pure+++-- | Add extra information which rules can depend on.+--   An oracle is a function from a question type @q@, to an answer type @a@.+--   As an example, we can define an oracle allowing you to depend on the current version of GHC:+--+-- @+-- newtype GhcVersion = GhcVersion () deriving (Show,Typeable,Eq,Hashable,Binary,NFData)+-- type instance RuleResult GhcVersion = String+-- rules = do+--     'addOracle' $ \\(GhcVersion _) -> 'Development.Shake.fromStdout' \<$\> 'Development.Shake.cmd' \"ghc --numeric-version\" :: Action String+--     ... rules ...+-- @+--+--   If a rule calls @'askOracle' (GhcVersion ())@, that rule will be rerun whenever the GHC version changes.+--   Some notes:+--+-- * We define @GhcVersion@ with a @newtype@ around @()@, allowing the use of @GeneralizedNewtypeDeriving@.+--   All the necessary type classes are exported from "Development.Shake.Classes".+--+-- * The @type instance@ requires the extension @TypeFamilies@.+--+-- * Each call to 'addOracle' must use a different type of question.+--+-- * Actions passed to 'addOracle' will be run in every build they are required, even if nothing else changes,+--   so be careful of slow actions.+--   If the result of an oracle does not change it will not invalidate any rules depending on it.+--   To always rerun files rules see 'Development.Shake.alwaysRerun'.+--+--   As a more complex example, consider tracking Haskell package versions:+--+-- @+-- newtype GhcPkgList = GhcPkgList () deriving (Show,Typeable,Eq,Hashable,Binary,NFData)+-- type instance RuleResult GhcPkgList = [(String, String)]+-- newtype GhcPkgVersion = GhcPkgVersion String deriving (Show,Typeable,Eq,Hashable,Binary,NFData)+-- type instance RuleResult GhcPkgVersion = Maybe String+--+-- rules = do+--     getPkgList \<- 'addOracle' $ \\GhcPkgList{} -> do+--         Stdout out <- 'Development.Shake.cmd' \"ghc-pkg list --simple-output\"+--         pure [(reverse b, reverse a) | x <- words out, let (a,_:b) = break (== \'-\') $ reverse x]+--+--     getPkgVersion \<- 'addOracle' $ \\(GhcPkgVersion pkg) -> do+--         pkgs <- getPkgList $ GhcPkgList ()+--         pure $ lookup pkg pkgs+--+--     \"myrule\" %> \\_ -> do+--         getPkgVersion $ GhcPkgVersion \"shake\"+--         ... rule using the shake version ...+-- @+--+--   Using these definitions, any rule depending on the version of @shake@+--   should call @getPkgVersion $ GhcPkgVersion \"shake\"@ to rebuild when @shake@ is upgraded.+--+--   If you apply 'versioned' to an oracle it will cause that oracle result to be discarded, and not do early-termination.+addOracle :: (RuleResult q ~ a, ShakeValue q, ShakeValue a, Partial) => (q -> Action a) -> Rules (q -> Action a)+addOracle = withFrozenCallStack $ addOracleFlavor Norm+++-- | An alternative to to 'addOracle' that relies on the 'hash' function providing a perfect equality,+--   doesn't support @--skip@, but requires less storage.+addOracleHash :: (RuleResult q ~ a, ShakeValue q, ShakeValue a, Partial) => (q -> Action a) -> Rules (q -> Action a)+addOracleHash = withFrozenCallStack $ addOracleFlavor Hash++-- | A combination of 'addOracle' and 'newCache' - an action that only runs when its dependencies change,+--   whose result is stored in the database.+--+-- * Does the information need recomputing every time? e.g. looking up stuff in the environment?+--   If so, use 'addOracle' instead.+--+-- * Is the action mostly deserisalising some file? If so, use 'newCache'.+--+-- * Is the operation expensive computation from other results? If so, use 'addOracleCache'.+--+--   An alternative to using 'addOracleCache' is introducing an intermediate file containing the result,+--   which requires less storage in the Shake database and can be inspected by existing file-system viewing+--   tools.+addOracleCache ::(RuleResult q ~ a, ShakeValue q, ShakeValue a, Partial) => (q -> Action a) -> Rules (q -> Action a)+addOracleCache = withFrozenCallStack $ addOracleFlavor Cache+++-- | Get information previously added with 'addOracle' or 'addOracleCache'.+--   The question/answer types must match those provided previously.+askOracle :: (RuleResult q ~ a, ShakeValue q, ShakeValue a) => q -> Action a+askOracle = fmap fromOracleA . apply1 . OracleQ++-- | A parallel version of 'askOracle'.+askOracles :: (RuleResult q ~ a, ShakeValue q, ShakeValue a) => [q] -> Action [a]+askOracles = fmap (map fromOracleA) . apply . map OracleQ
+ src/Development/Shake/Internal/Rules/OrderOnly.hs view
@@ -0,0 +1,31 @@++module Development.Shake.Internal.Rules.OrderOnly(+     orderOnly, orderOnlyBS+    ) where++import Development.Shake.Internal.Core.Types+import Development.Shake.Internal.Core.Action+import Development.Shake.Internal.Rules.File+import qualified Data.ByteString.Char8 as BS+++-- | Define order-only dependencies, these are dependencies that will always+--   be built before continuing, but which aren't dependencies of this action.+--   Mostly useful for defining generated dependencies you think might be real dependencies.+--   If they turn out to be real dependencies, you should add an explicit dependency afterwards.+--+-- @+-- \"source.o\" %> \\out -> do+--     'orderOnly' [\"header.h\"]+--     'cmd_' \"gcc -c source.c -o source.o -MMD -MF source.m\"+--     'neededMakefileDependencies' \"source.m\"+-- @+--+--   If @header.h@ is included by @source.c@ then the call to 'needMakefileDependencies' will cause+--   it to be added as a real dependency. If it isn't, then the rule won't rebuild if it changes.+orderOnly :: [FilePath] -> Action ()+orderOnly = orderOnlyAction . need+++orderOnlyBS :: [BS.ByteString] -> Action ()+orderOnlyBS = orderOnlyAction . needBS
+ src/Development/Shake/Internal/Rules/Rerun.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable, ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}++module Development.Shake.Internal.Rules.Rerun(+    defaultRuleRerun, alwaysRerun+    ) where++import Development.Shake.Internal.Core.Rules+import Development.Shake.Internal.Core.Types+import Development.Shake.Internal.Core.Build+import Development.Shake.Internal.Core.Action+import Development.Shake.Classes+import qualified Data.ByteString as BS+import General.Binary+++newtype AlwaysRerunQ = AlwaysRerunQ ()+    deriving (Typeable,Eq,Hashable,Binary,BinaryEx,NFData)+instance Show AlwaysRerunQ where show _ = "alwaysRerun"++type instance RuleResult AlwaysRerunQ = ()+++-- | Always rerun the associated action. Useful for defining rules that query+--   the environment. For example:+--+-- @+-- \"ghcVersion.txt\" 'Development.Shake.%>' \\out -> do+--     'alwaysRerun'+--     'Development.Shake.Stdout' stdout <- 'Development.Shake.cmd' \"ghc --numeric-version\"+--     'Development.Shake.writeFileChanged' out stdout+-- @+--+--   In @make@, the @.PHONY@ attribute on file-producing rules has a similar effect.+--+--   Note that 'alwaysRerun' is applied when a rule is executed. Modifying an existing rule+--   to insert 'alwaysRerun' will /not/ cause that rule to rerun next time.+alwaysRerun :: Action ()+alwaysRerun = do+    historyDisable+    apply1 $ AlwaysRerunQ ()++defaultRuleRerun :: Rules ()+defaultRuleRerun =+    addBuiltinRuleEx noLint noIdentity $+        \AlwaysRerunQ{} _ _ -> pure $ RunResult ChangedRecomputeDiff BS.empty ()
+ src/Development/Shake/Internal/Value.hs view
@@ -0,0 +1,111 @@+{-# LANGUAGE ExistentialQuantification, RecordWildCards, ScopedTypeVariables #-}+{-# LANGUAGE ConstraintKinds #-}++-- | This module implements the Key/Value types, to abstract over hetrogenous data types.+module Development.Shake.Internal.Value(+    Value, newValue, fromValue,+    Key, newKey, fromKey, typeKey,+    ShakeValue+    ) where++import Development.Shake.Classes+import Development.Shake.Internal.Errors+import Data.Typeable++import Unsafe.Coerce+++-- | Define an alias for the six type classes required for things involved in Shake rules.+--   Using this alias requires the @ConstraintKinds@ extension.+--+--   To define your own values meeting the necessary constraints it is convenient to use the extensions+--   @GeneralizedNewtypeDeriving@ and @DeriveDataTypeable@ to write:+--+-- > newtype MyType = MyType (String, Bool) deriving (Show, Typeable, Eq, Hashable, Binary, NFData)+--+--   Shake needs these instances on keys and values. They are used for:+--+-- * 'Show' is used to print out keys in errors, profiling, progress messages+--   and diagnostics.+--+-- * 'Typeable' is used because Shake indexes its database by the+--   type of the key and value involved in the rule (overlap is not+--   allowed for type classes and not allowed in Shake either).+--+-- * 'Eq' and 'Hashable' are used on keys in order to build hash maps+--   from keys to values.  'Eq' is used on values to test if the value+--   has changed or not (this is used to support unchanging rebuilds,+--   where Shake can avoid rerunning rules if it runs a dependency,+--   but it turns out that no changes occurred.)  The 'Hashable'+--   instances are only use at runtime (never serialised to disk),+--   so they do not have to be stable across runs.+--   Hashable on values is not used, and only required for a consistent interface.+--+-- * 'Binary' is used to serialize keys and values into Shake's+--   build database; this lets Shake cache values across runs and+--   implement unchanging rebuilds.+--+-- * 'NFData' is used to avoid space and thunk leaks, especially+--   when Shake is parallelized.+type ShakeValue a = (Show a, Typeable a, Eq a, Hashable a, Binary a, NFData a)++-- We deliberately avoid Typeable instances on Key/Value to stop them accidentally+-- being used inside themselves+data Key = forall a . Key+    {keyType :: TypeRep+    ,keyShow :: a -> String+    ,keyRnf :: a -> ()+    ,keyEq :: a -> a -> Bool+    ,keyHash :: Int -> a -> Int+    ,keyValue :: a+    }++data Value = forall a . Value+    {valueType :: TypeRep+    ,valueShow :: a -> String+    ,valueRnf :: a -> ()+    ,valueValue :: a+    }+++newKey :: forall a . ShakeValue a => a -> Key+newKey = Key (typeRep (Proxy :: Proxy a)) show rnf (==) hashWithSalt++newValue :: forall a . (Typeable a, Show a, NFData a) => a -> Value+newValue = Value (typeRep (Proxy :: Proxy a)) show rnf++typeKey :: Key -> TypeRep+typeKey Key{..} = keyType++fromKey :: forall a . Typeable a => Key -> a+fromKey Key{..}+    | keyType == resType = unsafeCoerce keyValue+    | otherwise = throwImpure $ errorInternal $ "fromKey, bad cast, have " ++ show keyType ++ ", wanted " ++ show resType+    where resType = typeRep (Proxy :: Proxy a)++fromValue :: forall a . Typeable a => Value -> a+fromValue Value{..}+    | valueType == resType = unsafeCoerce valueValue+    | otherwise = throwImpure $ errorInternal $ "fromValue, bad cast, have " ++ show valueType ++ ", wanted " ++ show resType+    where resType = typeRep (Proxy :: Proxy a)++instance Show Key where+    show Key{..} = keyShow keyValue++instance Show Value where+    show Value{..} = valueShow valueValue++instance NFData Key where+    rnf Key{..} = keyRnf keyValue++instance NFData Value where+    rnf Value{..} = valueRnf valueValue++instance Hashable Key where+    hash Key{..} = keyHash (hash keyType) keyValue+    hashWithSalt salt Key{..} = keyHash (hashWithSalt salt keyType) keyValue++instance Eq Key where+    Key{keyType=at,keyValue=a,keyEq=eq} == Key{keyType=bt,keyValue=b}+        | at /= bt = False+        | otherwise = eq a (unsafeCoerce b)
+ src/Development/Shake/Rule.hs view
@@ -0,0 +1,144 @@++-- | This module is used for defining new types of rules for Shake build systems, e.g. to support values stored in a database.+--   Most users will find the built-in set of rules sufficient. The functions in this module are designed for high-performance,+--   not ease of use or abstraction. As a result, they are difficult to work with and change more often than the other parts of Shake.+--   Before writing a builtin rule you are encouraged to use 'Development.Shake.addOracle' or 'Development.Shake.addOracleCache' if possible.+--   With all those warnings out the way, read on for the grungy details.+module Development.Shake.Rule(+    -- * Builtin rules+    -- $builtin_rules++    -- ** Extensions+    -- $extensions++    -- ** Worked example+    -- $example++    -- * Defining builtin rules+    -- | Functions and types for defining new types of Shake rules.+    addBuiltinRule,+    BuiltinLint, noLint, BuiltinIdentity, noIdentity, BuiltinRun, RunMode(..), RunChanged(..), RunResult(..),+    -- * Calling builtin rules+    -- | Wrappers around calling Shake rules. In general these should be specialised to a builtin rule.+    apply, apply1,+    -- * User rules+    -- | Define user rules that can be used by builtin rules.+    --   Absent any builtin rule making use of a user rule at a given type, a user rule will have on effect -+    --   they have no inherent effect or interpretation on their own.+    addUserRule, getUserRuleList, getUserRuleMaybe, getUserRuleOne,+    -- * Lint integration+    -- | Provide lint warnings when running code.+    lintTrackRead, lintTrackWrite, lintTrackAllow,+    -- * History caching+    -- | Interact with the non-local cache. When using the cache it is important that all+    --   rules have accurate 'BuiltinIdentity' functions.+    historyIsEnabled, historySave, historyLoad+    ) where++import Development.Shake.Internal.Core.Types+import Development.Shake.Internal.Core.Action+import Development.Shake.Internal.Core.Build+import Development.Shake.Internal.Core.Rules++-- $builtin_rules+--+--   Shake \"Builtin\" rules are ones map keys to values - e.g. files to file contents. For each builtin rule you need to think:+--+-- * What is the @key@ type, which uniquely identifies each location, e.g. a filename.+--+-- * What is the @value@ type. The @value@ is not necessarily the full value, but is the result people can get if they ask+--   for the value associated with the @key@. As an example, for files when you 'need' a file you don't get any value back from+--   the file, so a simple file rule could have @()@ as its value.+--+-- * What information is stored between runs. This information should be sufficient to check if the value has changed since last time,+--   e.g. the modification time for files.+--+--   Typically a custom rule will define a wrapper of type 'Rules' that calls 'addBuiltinRule', along with a type-safe wrapper over+--   'apply' so users can introduce dependencies.++-- $extensions+--+--   Once you have implemented the basic functionality there is more scope for embracing additional features of Shake, e.g.:+--+-- * You can integrate with cached history by providing a working 'BuiltinIdentity' and using 'historySave' and 'historyLoad'.+--+-- * You can let users provide their own rules which you interpret with 'addUserRule'.+--+-- * You can integrate with linting by specifying a richer 'BuiltinLint' and options like 'lintTrackRead'.+--+--   There are lots of rules defined in the Shake repo at <https://github.com/ndmitchell/shake/tree/master/src/Development/Shake/Internal/Rules>.+--   You are encouraged to read those for inspiration.++-- $example+--+--   Shake provides a very comprehensive file rule which currently runs to over 500 lines of code, and supports lots of features+--   and optimisations. However, let's imagine we want to define a simpler rule type for files. As mentioned earlier, we have to make some decisions.+--+-- * A @key@ will just be the file name.+--+-- * A @value@ will be @()@ - when the user depends on a file they don't expect any information in return.+--+-- * The stored information will be the contents of the file, in it's entirety. Alternative choices would be the modtime or a hash of the contents,+--   but Shake doesn't require that. The stored information in Shake must be stored in a 'ByteString', so we 'Data.ByteString.pack' and+--   'Data.ByteString.unpack' to convert.+--+-- * We will allow user rules to be defined saying how to build any individual file.+--+--   First we define the type of key and value, deriving all the necessary type classes. We define a @newtype@ over 'FilePath' so we can+--   guarantee not to conflict with anyone else. Typically you wouldn't export the @File@ type, providing only sugar functions over it.+--+-- > newtype File = File FilePath+-- >     deriving (Show,Eq,Hashable,Binary,NFData)+-- > type instance RuleResult File = ()+--+--   Since we have decided we are also going to have user rules, we need to define a new type to capture the information stored by the rules.+--   We need to store at least the file it is producing and the action, which we do with:+--+-- > data FileRule = FileRule File (Action ())+--+--   With the definitions above users could call 'apply' and 'addUserRule' directly, but that's tedious and not very type safe. To make it easier+--   we introduce some helpers:+--+-- > fileRule :: FilePath -> Action () -> Rules ()+-- > fileRule file act = addUserRule $ FileRule (File file) act+-- >+-- > fileNeed :: FilePath -> Action ()+-- > fileNeed = apply1 . File+--+--   These helpers just add our type names, providing a more pleasant interface for the user. Using these function we can+--   exercise our build system with:+--+-- > example = do+-- >     fileRule "a.txt" $ pure ()+-- >     fileRule "b.txt" $ do+-- >         fileNeed "a.txt"+-- >         liftIO $ writeFile "b.txt" . reverse =<< readFile "a.txt"+-- >+-- >     action $ fileNeed "b.txt"+--+--   This example defines rules for @a.txt@ (a source file) and @b.txt@ (the 'reverse' of @a.txt@). At runtime this example will+--   complain about not having a builtin rule for @File@, so the only thing left is to provide one.+--+-- > addBuiltinFileRule :: Rules ()+-- > addBuiltinFileRule = addBuiltinRule noLint noIdentity run+-- >     where+-- >         fileContents (File x) = do b <- IO.doesFileExist x; if b then IO.readFile' x else pure ""+-- >+-- >         run :: BuiltinRun File ()+-- >         run key old mode = do+-- >             now <- liftIO $ fileContents key+-- >             if mode == RunDependenciesSame && fmap BS.unpack old == Just now then+-- >                 pure $ RunResult ChangedNothing (BS.pack now) ()+-- >             else do+-- >                 (_, act) <- getUserRuleOne key (const Nothing) $ \(FileRule k act) -> if k == key then Just act else Nothing+-- >                 act+-- >                 now <- liftIO $ fileContents key+-- >                 pure $ RunResult ChangedRecomputeDiff (BS.pack now) ()+--+--   We define a wrapper @addBuiltinFileRule@ that calls @addBuiltinRule@, opting out of linting and cached storage.+--   The only thing we provide is a 'BuiltinRun' function which gets the previous state, and whether any dependency has changed,+--   and decides whether to rebuild. If something has changed we call 'getUserRuleOne' to find the users rule and rerun it.+--   The 'RunResult' says what changed (either 'ChangedNothing' or 'ChangedRecomputeDiff' in our cases), gives us a new stored value+--   (just packing the contents) and the @value@ which is @()@.+--+--   To execute our example we need to also call @addBuiltinFileRule@, and now everything works.
+ src/Development/Shake/Util.hs view
@@ -0,0 +1,91 @@+{-# OPTIONS_GHC -Wno-unused-imports #-} -- Required since foldl' moves to the prelude++-- | A module for useful utility functions for Shake build systems.+module Development.Shake.Util(+    parseMakefile, needMakefileDependencies, neededMakefileDependencies,+    shakeArgsAccumulate, shakeArgsPrune, shakeArgsPruneWith,+    ) where++import Development.Shake+import Development.Shake.Internal.Rules.File+import qualified Data.ByteString.Char8 as BS+import qualified General.Makefile as BS+import Data.Tuple.Extra+import Data.List (foldl')+import General.GetOpt+import Data.IORef+import Data.Maybe+import Control.Monad.Extra+import System.IO.Extra as IO+++-- | Given the text of a Makefile, extract the list of targets and dependencies. Assumes a+--   small subset of Makefile syntax, mostly that generated by @gcc -MM@.+--+-- > parseMakefile "a: b c\nd : e" == [("a",["b","c"]),("d",["e"])]+parseMakefile :: String -> [(FilePath, [FilePath])]+parseMakefile = map (BS.unpack *** map BS.unpack) . BS.parseMakefile . BS.pack+++-- | Depend on the dependencies listed in a Makefile. Does not depend on the Makefile itself.+--+-- > needMakefileDependencies file = need . concatMap snd . parseMakefile =<< liftIO (readFile file)+needMakefileDependencies :: FilePath -> Action ()+needMakefileDependencies file = needBS . concatMap snd . BS.parseMakefile =<< liftIO (BS.readFile file)+++-- | Depend on the dependencies listed in a Makefile. Does not depend on the Makefile itself.+--   Use this function to indicate that you have /already/ used the files in question.+--+-- > neededMakefileDependencies file = needed . concatMap snd . parseMakefile =<< liftIO (readFile file)+neededMakefileDependencies :: FilePath -> Action ()+neededMakefileDependencies file = neededBS . concatMap snd . BS.parseMakefile =<< liftIO (BS.readFile file)+++-- | Like `shakeArgsWith`, but instead of accumulating a list of flags, apply functions to a default value.+--   Usually used to populate a record structure. As an example of a build system that can use either @gcc@ or @distcc@ for compiling:+--+-- @+-- import System.Console.GetOpt+--+-- data Flags = Flags {distCC :: Bool} deriving Eq+-- flags = [Option \"\" [\"distcc\"] (NoArg $ Right $ \\x -> x{distCC=True}) \"Run distributed.\"]+--+-- main = 'shakeArgsAccumulate' 'shakeOptions' flags (Flags False) $ \\flags targets -> pure $ Just $ do+--     if null targets then 'want' [\"result.exe\"] else 'want' targets+--     let compiler = if distCC flags then \"distcc\" else \"gcc\"+--     \"*.o\" '%>' \\out -> do+--         'need' ...+--         'cmd' compiler ...+--     ...+-- @+--+--   Now you can pass @--distcc@ to use the @distcc@ compiler.+shakeArgsAccumulate :: ShakeOptions -> [OptDescr (Either String (a -> a))] -> a -> (a -> [String] -> IO (Maybe (Rules ()))) -> IO ()+shakeArgsAccumulate opts flags def f = shakeArgsWith opts flags $ \flags targets -> f (foldl' (flip ($)) def flags) targets+++-- | Like 'shakeArgs' but also takes a pruning function. If @--prune@ is passed, then after the build has completed,+--   the second argument is called with a list of the files that the build checked were up-to-date.+shakeArgsPrune :: ShakeOptions -> ([FilePath] -> IO ()) -> Rules () -> IO ()+shakeArgsPrune opts prune rules = shakeArgsPruneWith opts prune [] f+    where f _ files = pure $ Just $ if null files then rules else want files >> withoutActions rules+++-- | A version of 'shakeArgsPrune' that also takes a list of extra options to use.+shakeArgsPruneWith :: ShakeOptions -> ([FilePath] -> IO ()) -> [OptDescr (Either String a)] -> ([a] -> [String] -> IO (Maybe (Rules ()))) -> IO ()+shakeArgsPruneWith opts prune flags act = do+    let flags2 = Option "P" ["prune"] (NoArg $ Right Nothing) "Remove stale files" : map (fmapFmapOptDescr Just) flags+    pruning <- newIORef False+    shakeArgsWith opts flags2 $ \opts args ->+        case sequence opts of+            Nothing -> do+                writeIORef pruning True+                pure Nothing+            Just opts -> act opts args+    whenM (readIORef pruning) $+        IO.withTempFile $ \file -> do+            shakeArgsWith opts{shakeLiveFiles=file : shakeLiveFiles opts} flags2 $ \opts args ->+                act (catMaybes opts) args+            src <- lines <$> IO.readFile' file+            prune src
+ src/General/Bilist.hs view
@@ -0,0 +1,38 @@++-- | List type that supports O(1) amortized 'cons', 'snoc', 'uncons' and 'isEmpty'.+module General.Bilist(+    Bilist, cons, snoc, uncons, toList, isEmpty+    ) where++import Data.Semigroup+import Prelude+++data Bilist a = Bilist [a] [a]++toList :: Bilist a -> [a]+toList (Bilist as bs) = as ++ reverse bs++isEmpty :: Bilist a -> Bool+isEmpty (Bilist as bs) = null as && null bs++instance Eq a => Eq (Bilist a) where+    a == b = toList a == toList b++instance Semigroup (Bilist a) where+    a <> b = Bilist (toList a ++ toList b) []++instance Monoid (Bilist a) where+    mempty = Bilist [] []+    mappend = (<>)++cons :: a -> Bilist a -> Bilist a+cons x (Bilist as bs) = Bilist (x:as) bs++snoc :: Bilist a -> a -> Bilist a+snoc (Bilist as bs) x = Bilist as (x:bs)++uncons :: Bilist a -> Maybe (a, Bilist a)+uncons (Bilist [] []) = Nothing+uncons (Bilist (a:as) bs) = Just (a, Bilist as bs)+uncons (Bilist [] bs) = uncons $ Bilist (reverse bs) []
+ src/General/Binary.hs view
@@ -0,0 +1,232 @@+{-# LANGUAGE FlexibleInstances, ScopedTypeVariables, Rank2Types #-}++module General.Binary(+    BinaryOp(..), binaryOpMap,+    binarySplit, binarySplit2, binarySplit3, unsafeBinarySplit,+    Builder(..), runBuilder, sizeBuilder,+    BinaryEx(..),+    Storable, putExStorable, getExStorable, putExStorableList, getExStorableList,+    putExList, getExList, putExN, getExN+    ) where++import Development.Shake.Classes+import Control.Monad+import Data.Binary+import Data.List.Extra+import Data.Tuple.Extra+import Foreign.Marshal.Utils+import Foreign.Storable+import Foreign.Ptr+import System.IO.Unsafe as U+import qualified Data.ByteString as BS+import qualified Data.ByteString.Internal as BS+import qualified Data.ByteString.Unsafe as BS+import qualified Data.ByteString.Lazy as LBS+import qualified Data.ByteString.UTF8 as UTF8+import Data.Semigroup+import Prelude+++---------------------------------------------------------------------+-- STORE TYPE++-- | An explicit and more efficient version of Binary+data BinaryOp v = BinaryOp+    {putOp :: v -> Builder+    ,getOp :: BS.ByteString -> v+    }++binaryOpMap :: BinaryEx a => (a -> BinaryOp b) -> BinaryOp (a, b)+binaryOpMap mp = BinaryOp+    {putOp = \(a, b) -> putExN (putEx a) <> putOp (mp a) b+    ,getOp = \bs -> let (bs1,bs2) = getExN bs; a = getEx bs1 in (a, getOp (mp a) bs2)+    }+++binarySplit :: forall a . Storable a => BS.ByteString -> (a, BS.ByteString)+binarySplit bs | BS.length bs < sizeOf (undefined :: a) = error "Reading from ByteString, insufficient left"+               | otherwise = unsafeBinarySplit bs++binarySplit2 :: forall a b . (Storable a, Storable b) => BS.ByteString -> (a, b, BS.ByteString)+binarySplit2 bs | BS.length bs < sizeOf (undefined :: a) + sizeOf (undefined :: b) = error "Reading from ByteString, insufficient left"+                | (a,bs) <- unsafeBinarySplit bs, (b,bs) <- unsafeBinarySplit bs = (a,b,bs)++binarySplit3 :: forall a b c . (Storable a, Storable b, Storable c) => BS.ByteString -> (a, b, c, BS.ByteString)+binarySplit3 bs | BS.length bs < sizeOf (undefined :: a) + sizeOf (undefined :: b) + sizeOf (undefined :: c) = error "Reading from ByteString, insufficient left"+                | (a,bs) <- unsafeBinarySplit bs, (b,bs) <- unsafeBinarySplit bs, (c,bs) <- unsafeBinarySplit bs = (a,b,c,bs)+++unsafeBinarySplit :: Storable a => BS.ByteString -> (a, BS.ByteString)+unsafeBinarySplit bs = (v, BS.unsafeDrop (sizeOf v) bs)+    where v = unsafePerformIO $ BS.unsafeUseAsCString bs $ \ptr -> peek (castPtr ptr)+++-- forM for zipWith+for2M_ as bs f = zipWithM_ f as bs++---------------------------------------------------------------------+-- BINARY SERIALISATION++-- We can't use the Data.ByteString builder as that doesn't track the size of the chunk.+data Builder = Builder {-# UNPACK #-} !Int (forall a . Ptr a -> Int -> IO ())++sizeBuilder :: Builder -> Int+sizeBuilder (Builder i _) = i++runBuilder :: Builder -> BS.ByteString+runBuilder (Builder i f) = unsafePerformIO $ BS.create i $ \ptr -> f ptr 0++instance Semigroup Builder where+    (Builder x1 x2) <> (Builder y1 y2) = Builder (x1+y1) $ \p i -> do x2 p i; y2 p $ i+x1++instance Monoid Builder where+    mempty = Builder 0 $ \_ _ -> pure ()+    mappend = (<>)++-- | Methods for Binary serialisation that go directly between strict ByteString values.+--   When the Database is read each key/value will be loaded as a separate ByteString,+--   and for certain types (e.g. file rules) this may remain the preferred format for storing keys.+--   Optimised for performance.+class BinaryEx a where+    putEx :: a -> Builder+    getEx :: BS.ByteString -> a++instance BinaryEx BS.ByteString where+    putEx x = Builder n $ \ptr i -> BS.unsafeUseAsCString x $ \bs -> copyBytes (ptr `plusPtr` i) (castPtr bs) (fromIntegral n)+        where n = BS.length x+    getEx = id++instance BinaryEx LBS.ByteString where+    putEx x = Builder (fromIntegral $ LBS.length x) $ \ptr i -> do+        let go _ [] = pure ()+            go i (x:xs) = do+                let n = BS.length x+                BS.unsafeUseAsCString x $ \bs -> copyBytes (ptr `plusPtr` i) (castPtr bs) (fromIntegral n)+                go (i+n) xs+        go i $ LBS.toChunks x+    getEx = LBS.fromChunks . pure++instance BinaryEx [BS.ByteString] where+    -- Format:+    -- n :: Word32 - number of strings+    -- ns :: [Word32]{n} - length of each string+    -- contents of each string concatenated (sum ns bytes)+    putEx xs = Builder (4 + (n * 4) + sum ns) $ \p i -> do+        pokeByteOff p i (fromIntegral n :: Word32)+        for2M_ [4+i,8+i..] ns $ \i x -> pokeByteOff p i (fromIntegral x :: Word32)+        p<- pure $ p `plusPtr` (i + 4 + (n * 4))+        for2M_ (scanl (+) 0 ns) xs $ \i x -> BS.unsafeUseAsCStringLen x $ \(bs, n) ->+            copyBytes (p `plusPtr` i) (castPtr bs) (fromIntegral n)+        where ns = map BS.length xs+              n = length ns++    getEx bs = unsafePerformIO $ BS.unsafeUseAsCString bs $ \p -> do+        n <- fromIntegral <$> (peekByteOff p 0 :: IO Word32)+        ns :: [Word32] <- forM [1..fromIntegral n] $ \i -> peekByteOff p (i * 4)+        pure $ snd $ mapAccumL (\bs i -> swap $ BS.splitAt (fromIntegral i) bs) (BS.drop (4 + (n * 4)) bs) ns++instance BinaryEx () where+    putEx () = mempty+    getEx _ = ()++instance BinaryEx String where+    putEx = putEx . UTF8.fromString+    getEx = UTF8.toString++instance BinaryEx (Maybe String) where+    putEx Nothing = mempty+    putEx (Just xs) = putEx $ UTF8.fromString $ '\0' : xs+    getEx = fmap snd . uncons . UTF8.toString++instance BinaryEx [String] where+    putEx = putEx . map UTF8.fromString+    getEx = map UTF8.toString . getEx++instance BinaryEx (String, [String]) where+    putEx (a,bs) = putEx $ a:bs+    getEx x = let a:bs = getEx x in (a,bs)++instance BinaryEx Bool where+    putEx False = Builder 1 $ \ptr i -> pokeByteOff ptr i (0 :: Word8)+    putEx True = mempty+    getEx = BS.null++instance BinaryEx Word8 where+    putEx = putExStorable+    getEx = getExStorable++instance BinaryEx Word16 where+    putEx = putExStorable+    getEx = getExStorable++instance BinaryEx Word32 where+    putEx = putExStorable+    getEx = getExStorable++instance BinaryEx Int where+    putEx = putExStorable+    getEx = getExStorable++instance BinaryEx Float where+    putEx = putExStorable+    getEx = getExStorable+++putExStorable :: forall a . Storable a => a -> Builder+putExStorable x = Builder (sizeOf x) $ \p i -> pokeByteOff p i x++getExStorable :: forall a . Storable a => BS.ByteString -> a+getExStorable = \bs -> unsafePerformIO $ BS.unsafeUseAsCStringLen bs $ \(p, size) ->+        if size /= n then error "size mismatch" else peek (castPtr p)+    where n = sizeOf (undefined :: a)+++putExStorableList :: forall a . Storable a => [a] -> Builder+putExStorableList xs = Builder (n * length xs) $ \ptr i ->+    for2M_ [i,i+n..] xs $ \i x -> pokeByteOff ptr i x+    where n = sizeOf (undefined :: a)++getExStorableList :: forall a . Storable a => BS.ByteString -> [a]+getExStorableList = \bs -> unsafePerformIO $ BS.unsafeUseAsCStringLen bs $ \(p, size) ->+    let (d,m) = size `divMod` n in+    if m /= 0 then error "size mismatch" else forM [0..d-1] $ \i -> peekElemOff (castPtr p) i+    where n = sizeOf (undefined :: a)+++-- repeating:+--     Word32, length of BS+--     BS+putExList :: [Builder] -> Builder+putExList xs = Builder (sum $ map (\b -> sizeBuilder b + 4) xs) $ \p i -> do+    let go _ [] = pure ()+        go i (Builder n b:xs) = do+            pokeByteOff p i (fromIntegral n :: Word32)+            b p (i+4)+            go (i+4+n) xs+    go i xs++getExList :: BS.ByteString -> [BS.ByteString]+getExList bs+    | len == 0 = []+    | len >= 4+    , (n :: Word32, bs) <- unsafeBinarySplit bs+    , n <- fromIntegral n+    , (len - 4) >= n+    = BS.unsafeTake n bs : getExList (BS.unsafeDrop n bs)+    | otherwise = error "getList, corrupted binary"+    where len = BS.length bs++putExN :: Builder -> Builder+putExN (Builder n old) = Builder (n+4) $ \p i -> do+    pokeByteOff p i (fromIntegral n :: Word32)+    old p $ i+4++getExN :: BS.ByteString -> (BS.ByteString, BS.ByteString)+getExN bs+    | len >= 4+    , (n :: Word32, bs) <- unsafeBinarySplit bs+    , n <- fromIntegral n+    , (len - 4) >= n+    = (BS.unsafeTake n bs, BS.unsafeDrop n bs)+    | otherwise = error "getList, corrupted binary"+    where len = BS.length bs
+ src/General/Chunks.hs view
@@ -0,0 +1,147 @@+{-# LANGUAGE RecordWildCards, ScopedTypeVariables #-}++module General.Chunks(+    Chunks,+    readChunk, readChunkMax, usingWriteChunks, writeChunk,+    restoreChunksBackup, usingChunks, resetChunksCompact, resetChunksCorrupt+    ) where++import System.Time.Extra+import System.FilePath+import Control.Concurrent.Extra+import Control.Monad.Extra+import Control.Exception+import System.IO+import System.Directory+import qualified Data.ByteString as BS+import Data.Word+import Data.Monoid+import General.Binary+import General.Extra+import General.Cleanup+import General.Thread+import Prelude+++data Chunks = Chunks+    {chunksFileName :: FilePath+    ,chunksFlush :: Maybe Seconds+    ,chunksHandle :: MVar Handle+    }+++---------------------------------------------------------------------+-- READ/WRITE OPERATIONS++readChunk :: Chunks -> IO (Either BS.ByteString BS.ByteString)+readChunk c = readChunkMax c maxBound++-- | Return either a valid chunk (Right), or a trailing suffix with no information (Left)+readChunkMax :: Chunks -> Word32 -> IO (Either BS.ByteString BS.ByteString)+readChunkMax Chunks{..} mx = withMVar chunksHandle $ \h -> readChunkDirect h mx++readChunkDirect :: Handle -> Word32 -> IO (Either BS.ByteString BS.ByteString)+readChunkDirect h mx = do+    let slop x = do+            unless (BS.null x) $ hSetFileSize h . subtract (toInteger $ BS.length x) =<< hFileSize h+            pure $ Left x+    n <- BS.hGet h 4+    if BS.length n < 4 then slop n else do+        let count = fromIntegral $ min mx $ fst $ unsafeBinarySplit n+        v <- BS.hGet h count+        if BS.length v < count then slop (n `BS.append` v) else pure $ Right v++writeChunkDirect :: Handle -> Builder -> IO ()+writeChunkDirect h x = bs `seq` BS.hPut h bs+    where bs = runBuilder $ putEx (fromIntegral $ sizeBuilder x :: Word32) <> x+++-- | If 'writeChunks' and any of the reopen operations are interleaved it will cause issues.+usingWriteChunks :: Cleanup -> Chunks -> IO (Builder -> IO ())+-- We avoid calling flush too often on SSD drives, as that can be slow+-- Make sure all exceptions happen on the caller, so we don't have to move exceptions back+-- Make sure we only write on one thread, otherwise async exceptions can cause partial writes+usingWriteChunks cleanup Chunks{..} = do+    h <- allocate cleanup (takeMVar chunksHandle) (putMVar chunksHandle)+    chan <- newChan -- operations to perform on the file+    kick <- newEmptyMVar -- kicked whenever something is written+    died <- newBarrier -- has the writing thread finished++    whenJust chunksFlush $ \flush ->+        allocateThread cleanup $ forever $ do+            takeMVar kick+            sleep flush+            tryTakeMVar kick+            writeChan chan $ hFlush h >> pure True++    -- pump the thread while we are running+    -- once we abort, let everything finish flushing first+    -- the mask_ is very important - we don't want to abort until everything finishes+    allocateThread cleanup $ mask_ $ whileM $ join $ readChan chan+    -- this cleanup will run before we attempt to kill the thread+    register cleanup $ writeChan chan $ pure False++    pure $ \s -> do+        out <- evaluate $ writeChunkDirect h s -- ensure exceptions occur on this thread+        writeChan chan $ out >> tryPutMVar kick () >> pure True+++writeChunk :: Chunks -> Builder -> IO ()+writeChunk Chunks{..} x = withMVar chunksHandle $ \h -> writeChunkDirect h x+++---------------------------------------------------------------------+-- FILENAME OPERATIONS++backup x = x <.> "backup"++restoreChunksBackup :: FilePath -> IO Bool+restoreChunksBackup file = do+    -- complete a partially failed compress+    b <- doesFileExist $ backup file+    if not b then pure False else do+        removeFile_ file+        renameFile (backup file) file+        pure True+++usingChunks :: Cleanup -> FilePath -> Maybe Seconds -> IO Chunks+usingChunks cleanup file flush = do+    h <- newEmptyMVar+    allocate cleanup+        (putMVar h =<< openFile file ReadWriteMode)+        (const $ hClose =<< takeMVar h)+    pure $ Chunks file flush h+++-- | The file is being compacted, if the process fails, use a backup.+resetChunksCompact :: Chunks -> ((Builder -> IO ()) -> IO a) -> IO a+resetChunksCompact Chunks{..} act = mask $ \restore -> do+    h <- takeMVar chunksHandle+    flip onException (putMVar chunksHandle h) $ restore $ do+        hClose h+        copyFile chunksFileName $ backup chunksFileName+    h <- openFile chunksFileName ReadWriteMode+    flip finally (putMVar chunksHandle h) $ restore $ do+        hSetFileSize h 0+        hSeek h AbsoluteSeek 0+        res <- act $ writeChunkDirect h+        hFlush h+        removeFile $ backup chunksFileName+        pure res+++-- | The file got corrupted, return a new version.+resetChunksCorrupt :: Maybe FilePath -> Chunks -> IO ()+resetChunksCorrupt copy Chunks{..} = mask $ \restore -> do+    h <- takeMVar chunksHandle+    h <- case copy of+        Nothing -> pure h+        Just copy -> do+            flip onException (putMVar chunksHandle h) $ restore $ do+                hClose h+                copyFile chunksFileName copy+            openFile chunksFileName ReadWriteMode+    flip finally (putMVar chunksHandle h) $ do+        hSetFileSize h 0+        hSeek h AbsoluteSeek 0
+ src/General/Cleanup.hs view
@@ -0,0 +1,63 @@++-- | Code for ensuring cleanup actions are run.+module General.Cleanup(+    Cleanup, newCleanup, withCleanup,+    register, release, allocate, unprotect+    ) where++import Control.Exception+import qualified Data.HashMap.Strict as Map+import Data.IORef+import Data.List.Extra+import Data.Maybe+++data S = S+    {unique :: {-# UNPACK #-} !Int -- next index to be used to items+    ,items :: !(Map.HashMap Int (IO ()))+    }++newtype Cleanup = Cleanup (IORef S)++data ReleaseKey = ReleaseKey (IORef S) {-# UNPACK #-} !Int+++-- | Run with some cleanup scope. Regardless of exceptions/threads, all 'register' actions+--   will be run by the time it exits.+--   The 'register' actions will be run in reverse order, i.e. the last to be added will be run first.+withCleanup :: (Cleanup -> IO a) -> IO a+withCleanup act = do+    (c, clean) <- newCleanup+    act c `finally` clean++newCleanup :: IO (Cleanup, IO ())+newCleanup = do+    ref <- newIORef $ S 0 Map.empty+    -- important to use uninterruptibleMask_ otherwise in things like allocateThread+    -- we might end up being interrupted and failing to close down the thread+    -- e.g. see https://github.com/digital-asset/ghcide/issues/381+    -- note that packages like safe-exceptions also use uninterruptibleMask_+    let clean = uninterruptibleMask_ $ do+            items <- atomicModifyIORef' ref $ \s -> (s{items=Map.empty}, items s)+            mapM_ snd $ sortOn (negate . fst) $ Map.toList items+    pure (Cleanup ref, clean)+++register :: Cleanup -> IO () -> IO ReleaseKey+register (Cleanup ref) act = atomicModifyIORef' ref $ \s -> let i = unique s in+    (S (unique s + 1) (Map.insert i act $ items s), ReleaseKey ref i)++unprotect :: ReleaseKey -> IO ()+unprotect (ReleaseKey ref i) = atomicModifyIORef' ref $ \s -> (s{items = Map.delete i $ items s}, ())++release :: ReleaseKey -> IO ()+release (ReleaseKey ref i) = uninterruptibleMask_ $ do+    undo <- atomicModifyIORef' ref $ \s -> (s{items = Map.delete i $ items s}, Map.lookup i $ items s)+    fromMaybe (pure ()) undo++allocate :: Cleanup -> IO a -> (a -> IO ()) -> IO a+allocate cleanup acquire release =+    mask_ $ do+        v <- acquire+        register cleanup $ release v+        pure v
+ src/General/EscCodes.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE CPP #-}++-- | Working with escape sequences+module General.EscCodes(+    Color(..),+    checkEscCodes,+    removeEscCodes,+    escWindowTitle,+    escCursorUp,+    escClearLine,+    escForeground,+    escNormal+    ) where++import Data.Char+import Data.List.Extra+import System.IO+import System.Environment+import System.IO.Unsafe++#ifdef mingw32_HOST_OS+import Data.Word+import Data.Bits+import Foreign.Ptr+import Foreign.Storable+import Foreign.Marshal.Alloc+#endif++checkEscCodes :: IO Bool+checkEscCodes = pure checkEscCodesOnce++{-# NOINLINE checkEscCodesOnce #-}+checkEscCodesOnce :: Bool+checkEscCodesOnce = unsafePerformIO $ do+    hdl <- hIsTerminalDevice stdout+    env <- maybe False (/= "dumb") <$> lookupEnv "TERM"+    if hdl && env then pure True else+#ifdef mingw32_HOST_OS+        checkEscCodesWindows+#else+        pure False+#endif++#ifdef mingw32_HOST_OS++#ifdef x86_64_HOST_ARCH+#define CALLCONV ccall+#else+#define CALLCONV stdcall+#endif++foreign import CALLCONV unsafe "Windows.h GetStdHandle" c_GetStdHandle :: Word32 -> IO (Ptr ())+foreign import CALLCONV unsafe "Windows.h GetConsoleMode" c_GetConsoleModule :: Ptr () -> Ptr Word32 -> IO Bool+foreign import CALLCONV unsafe "Windows.h SetConsoleMode" c_SetConsoleMode :: Ptr () -> Word32 -> IO Bool++c_STD_OUTPUT_HANDLE = 4294967285 :: Word32 -- (-11) for some reason+c_ENABLE_VIRTUAL_TERMINAL_PROCESSING = 0x0004 :: Word32+++-- | Try and get the handle attributes, if they are all satisifed, return True.+--   If they aren't, try and set it to emulated mode.+checkEscCodesWindows :: IO Bool+checkEscCodesWindows = do+    h <- c_GetStdHandle c_STD_OUTPUT_HANDLE+    -- might return INVALID_HANDLE_VALUE, but then the next step will happily fail+    mode <- alloca $ \v -> do+        b <- c_GetConsoleModule h v+        if b then Just <$> peek v else pure Nothing+    case mode of+        Nothing -> pure False+        Just mode -> do+            let modeNew = mode .|. c_ENABLE_VIRTUAL_TERMINAL_PROCESSING+            if mode == modeNew then pure True else do+                c_SetConsoleMode h modeNew+#endif++removeEscCodes :: String -> String+removeEscCodes ('\ESC':'[':xs) = removeEscCodes $ drop1 $ dropWhile (not . isAlpha) xs+removeEscCodes (x:xs) = x : removeEscCodes xs+removeEscCodes [] = []+++escWindowTitle :: String -> String+escWindowTitle x = "\ESC]0;" ++ x ++ "\BEL"++escCursorUp :: Int -> String+escCursorUp i = "\ESC[" ++ show i ++ "A"++escClearLine :: String+escClearLine = "\ESC[K"+++data Color = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White+    deriving (Show,Enum)++escForeground :: Color -> String+escForeground x = "\ESC[" ++ show (30 + fromEnum x) ++ "m"++escNormal :: String+escNormal = "\ESC[0m"
+ src/General/Extra.hs view
@@ -0,0 +1,323 @@+{-# LANGUAGE CPP, ScopedTypeVariables, ConstraintKinds, GeneralizedNewtypeDeriving #-}+{-# OPTIONS_GHC -Wno-x-partial -Wno-unrecognised-warning-flags #-}++module General.Extra(+    getProcessorCount,+    findGcc,+    whenLeft,+    randomElem,+    wrapQuote, showBracket,+    withs, forNothingM,+    maximum', maximumBy',+    unconcat,+    fastAt,+    headErr, tailErr,+    zipExact, zipWithExact,+    isAsyncException,+    showDurationSecs,+    usingLineBuffering,+    doesFileExist_, doesDirectoryExist_,+    usingNumCapabilities,+    removeFile_, createDirectoryRecursive,+    catchIO, tryIO, handleIO, handleSynchronous,+    Located, Partial, callStackTop, callStackFull, withFrozenCallStack, callStackFromException,+    Ver(..), makeVer,+    QTypeRep(..),+    NoShow(..)+    ) where++import Control.Exception.Extra+import Data.Char+import Data.List.Extra+import System.Environment+import Development.Shake.FilePath+import Control.DeepSeq+import General.Cleanup+import Data.Typeable+import System.IO.Error+import System.IO.Extra+import System.Time.Extra+import System.IO.Unsafe+import System.Info.Extra+import System.Random+import System.Directory+import System.Exit+import Numeric.Extra+import Foreign.Storable+import Control.Concurrent.Extra+import Data.Maybe+import Data.Hashable+import Data.Primitive.Array+import Control.Monad+import Control.Monad.ST+import GHC.Conc(getNumProcessors)+import GHC.Stack+++---------------------------------------------------------------------+-- Prelude++-- See https://ghc.haskell.org/trac/ghc/ticket/10830 - they broke maximumBy+maximumBy' :: (a -> a -> Ordering) -> [a] -> a+maximumBy' cmp = foldl1' $ \x y -> if cmp x y == GT then x else y++maximum' :: Ord a => [a] -> a+maximum' = maximumBy' compare++newtype NoShow a = NoShow a+instance Show (NoShow a) where show _ = "NoShow"++unconcat :: [[a]] -> [b] -> [[b]]+unconcat [] _ = []+unconcat (a:as) bs = b1 : unconcat as b2+    where (b1,b2) = splitAt (length a) bs++headErr :: [a] -> a+headErr = head++tailErr :: [a] -> [a]+tailErr = tail+++---------------------------------------------------------------------+-- Data.List++-- | If a string has any spaces then put quotes around and double up all internal quotes.+--   Roughly the inverse of Windows command line parsing.+wrapQuote :: String -> String+wrapQuote xs | any isSpace xs = "\"" ++ concatMap (\x -> if x == '\"' then "\"\"" else [x]) xs ++ "\""+             | otherwise = xs++-- | If a string has any spaces then put brackets around it.+wrapBracket :: String -> String+wrapBracket xs | any isSpace xs = "(" ++ xs ++ ")"+               | otherwise = xs++-- | Alias for @wrapBracket . show@.+showBracket :: Show a => a -> String+showBracket = wrapBracket . show+++-- | Version of '!!' which is fast and returns 'Nothing' if the index is not present.+fastAt :: [a] -> (Int -> Maybe a)+fastAt xs = \i -> if i < 0 || i >= n then Nothing else Just $ indexArray arr i+    where+        n = length xs+        arr = runST $ do+            let n = length xs+            arr <- newArray n undefined+            forM_ (zipFrom 0 xs) $ \(i,x) ->+                writeArray arr i x+            unsafeFreezeArray arr++zipWithExact :: Partial => (a -> b -> c) -> [a] -> [b] -> [c]+zipWithExact f = g+    where+        g [] [] = []+        g (a:as) (b:bs) = f a b : g as bs+        g _ _ = error "zipWithExacts: unequal lengths"++zipExact :: Partial => [a] -> [b] -> [(a,b)]+zipExact = zipWithExact (,)+++---------------------------------------------------------------------+-- System.Info++{-# NOINLINE getProcessorCount #-}+getProcessorCount :: IO Int+-- unsafePefromIO so we cache the result and only compute it once+getProcessorCount = let res = unsafePerformIO act in pure res+    where+        act =+            if rtsSupportsBoundThreads then+                fromIntegral <$> getNumProcessors+            else do+                env <- lookupEnv "NUMBER_OF_PROCESSORS"+                case env of+                    Just s | [(i,"")] <- reads s -> pure i+                    _ -> do+                        src <- readFile' "/proc/cpuinfo" `catchIO` \_ -> pure ""+                        pure $! max 1 $ length [() | x <- lines src, "processor" `isPrefixOf` x]+++-- Can you find a GCC executable? return a Bool, and optionally something to add to $PATH to run it+findGcc :: IO (Bool, Maybe FilePath)+findGcc = do+    v <- findExecutable "gcc"+    case v of+        Nothing | isWindows -> do+            ghc <- findExecutable "ghc"+            case ghc of+                Just ghc -> do+                    let gcc = takeDirectory (takeDirectory ghc) </> "mingw/bin/gcc.exe"+                    b <- doesFileExist_ gcc+                    pure $ if b then (True, Just $ takeDirectory gcc) else (False, Nothing)+                _ -> pure (False, Nothing)+        _ -> pure (isJust v, Nothing)++++---------------------------------------------------------------------+-- System.Random++randomElem :: [a] -> IO a+randomElem xs = do+    when (null xs) $ fail "General.Extra.randomElem called with empty list, can't pick a random element"+    i <- randomRIO (0, length xs - 1)+    pure $ xs !! i+++---------------------------------------------------------------------+-- System.IO++usingLineBuffering :: Cleanup -> IO ()+usingLineBuffering cleanup = do+    out <- hGetBuffering stdout+    err <- hGetBuffering stderr+    when (out /= LineBuffering || err /= LineBuffering) $ do+        register cleanup $ hSetBuffering stdout out >> hSetBuffering stderr err+        hSetBuffering stdout LineBuffering >> hSetBuffering stderr LineBuffering+++---------------------------------------------------------------------+-- System.Time++showDurationSecs :: Seconds -> String+showDurationSecs = replace ".00s" "s" . showDuration . intToDouble . round+++---------------------------------------------------------------------+-- Control.Monad++withs :: [(a -> r) -> r] -> ([a] -> r) -> r+withs [] act = act []+withs (f:fs) act = f $ \a -> withs fs $ \as -> act $ a:as++forNothingM :: Monad m => [a] -> (a -> m (Maybe b)) -> m (Maybe [b])+forNothingM [] f = pure $ Just []+forNothingM (x:xs) f = do+    v <- f x+    case v of+        Nothing -> pure Nothing+        Just v -> liftM (v:) `liftM` forNothingM xs f+++---------------------------------------------------------------------+-- Control.Concurrent++usingNumCapabilities :: Cleanup -> Int -> IO ()+usingNumCapabilities cleanup new = when rtsSupportsBoundThreads $ do+    old <- getNumCapabilities+    when (old /= new) $ do+        register cleanup $ setNumCapabilities old+        setNumCapabilities new+++---------------------------------------------------------------------+-- Control.Exception++-- | Is the exception asynchronous, not a "coding error" that should be ignored+isAsyncException :: SomeException -> Bool+isAsyncException e+    | Just (_ :: AsyncException) <- fromException e = True+    | Just (_ :: ExitCode) <- fromException e = True+    | otherwise = False++catchIO :: IO a -> (IOException -> IO a) -> IO a+catchIO = catch++tryIO :: IO a -> IO (Either IOException a)+tryIO = try++handleIO :: (IOException -> IO a) -> IO a -> IO a+handleIO = handle++handleSynchronous :: (SomeException -> IO a) -> IO a -> IO a+handleSynchronous = handleBool (not . isAsyncException)++---------------------------------------------------------------------+-- System.Directory++doesFileExist_ :: FilePath -> IO Bool+doesFileExist_ x = doesFileExist x `catchIO` \_ -> pure False++doesDirectoryExist_ :: FilePath -> IO Bool+doesDirectoryExist_ x = doesDirectoryExist x `catchIO` \_ -> pure False++-- | Remove a file, but don't worry if it fails+removeFile_ :: FilePath -> IO ()+removeFile_ x =+    removeFile x `catchIO` \e ->+        when (isPermissionError e) $ handleIO (\_ -> pure ()) $ do+            perms <- getPermissions x+            setPermissions x perms{readable = True, searchable = True, writable = True}+            removeFile x+++-- | Like @createDirectoryIfMissing True@ but faster, as it avoids+--   any work in the common case the directory already exists.+createDirectoryRecursive :: FilePath -> IO ()+createDirectoryRecursive dir = do+    x <- tryIO $ doesDirectoryExist dir+    when (x /= Right True) $ createDirectoryIfMissing True dir+++---------------------------------------------------------------------+-- Data.Either++whenLeft :: Applicative m => Either a b -> (a -> m ()) -> m ()+whenLeft x f = either f (const $ pure ()) x+++---------------------------------------------------------------------+-- Data.CallStack++type Located = Partial++callStackTop :: Partial => String+callStackTop = withFrozenCallStack $ headDef "unknown location" callStackFull++callStackFull :: Partial => [String]+callStackFromException :: SomeException -> ([String], SomeException)+++-- | Invert 'prettyCallStack', which GHC pre-applies in certain cases+parseCallStack = reverse . map trimStart . drop1 . lines++callStackFull = parseCallStack $ prettyCallStack $ popCallStack callStack++#if __GLASGOW_HASKELL__ < 912+callStackFromException e | Just (ErrorCallWithLocation msg loc) <- fromException e = (parseCallStack loc, toException $ ErrorCall msg)+#endif+callStackFromException e = ([], e)+++---------------------------------------------------------------------+-- Data.Version++-- | A version number that indicates change, not ordering or compatibility.+--   Always presented as an 'Int' to the user, but a newtype inside the library for safety.+newtype Ver = Ver Int+    deriving (Show,Eq,Storable)++makeVer :: String -> Ver+makeVer = Ver . hash+++---------------------------------------------------------------------+-- Data.Typeable++-- | Like TypeRep, but the Show includes enough information to be unique+--   so I can rely on @a == b === show a == show b@.+newtype QTypeRep = QTypeRep {fromQTypeRep :: TypeRep}+    deriving (Eq,Hashable,NFData)++instance Show QTypeRep where+    -- Need to show enough so that different types with the same names don't clash+    -- But can't show too much or the history is not portable https://github.com/ndmitchell/shake/issues/670+    show (QTypeRep x) = f x+        where+            f x = ['(' | xs /= []] ++ (unwords $ g c : map f xs) ++ [')' | xs /= []]+                where (c, xs) = splitTyConApp x+            g x = tyConModule x ++ "." ++ tyConName x
+ src/General/Fence.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE LambdaCase #-}++module General.Fence(+    Fence, newFence, signalFence, waitFence, testFence,+    exceptFence+    ) where++import Control.Monad+import Control.Monad.IO.Class+import Control.Exception.Extra+import Development.Shake.Internal.Errors+import Data.Maybe+import Data.Either.Extra+import Data.IORef+++---------------------------------------------------------------------+-- FENCE++-- | Like a barrier, but based on callbacks+newtype Fence m a = Fence (IORef (Either (a -> m ()) a))+instance Show (Fence m a) where show _ = "Fence"++newFence :: MonadIO m => IO (Fence m a)+newFence = Fence <$> newIORef (Left $ const $ pure ())++signalFence :: (Partial, MonadIO m) => Fence m a -> a -> m ()+signalFence (Fence ref) v = join $ liftIO $ atomicModifyIORef' ref $ \case+    Left queue -> (Right v, queue v)+    Right _ -> throwImpure $ errorInternal "signalFence called twice on one Fence"++waitFence :: MonadIO m => Fence m a -> (a -> m ()) -> m ()+waitFence (Fence ref) call = join $ liftIO $ atomicModifyIORef' ref $ \case+    Left queue -> (Left (\a -> queue a >> call a), pure ())+    Right v -> (Right v, call v)++testFence :: Fence m a -> IO (Maybe a)+testFence (Fence x) = eitherToMaybe <$> readIORef x+++---------------------------------------------------------------------+-- FENCE COMPOSITES++exceptFence :: MonadIO m => [Fence m (Either e r)] -> m (Fence m (Either e [r]))+exceptFence xs = do+    -- number of items still to complete, becomes negative after it has triggered+    todo <- liftIO $ newIORef $ length xs+    fence <- liftIO newFence++    forM_ xs $ \x -> waitFence x $ \res ->+        join $ liftIO $ atomicModifyIORef' todo $ \i -> case res of+            Left e | i >= 0 -> (-1, signalFence fence $ Left e)+            _ | i == 1 -> (-1, signalFence fence . Right =<< liftIO (mapM (fmap (fromRight' . fromJust) . testFence) xs))+              | otherwise -> (i-1, pure ())+    pure fence
+ src/General/FileLock.hs view
@@ -0,0 +1,82 @@+{-# LANGUAGE CPP #-}++module General.FileLock(usingLockFile) where++import Control.Exception.Extra+import System.FilePath+import General.Extra+import General.Cleanup+#ifdef mingw32_HOST_OS+import Control.Monad+import Data.Bits+import Data.Word+import Foreign.Ptr+import Foreign.C.String+#else+import System.IO+import System.Posix.IO+#endif++#ifdef mingw32_HOST_OS++#ifdef x86_64_HOST_ARCH+#define CALLCONV ccall+#else+#define CALLCONV stdcall+#endif++foreign import CALLCONV unsafe "Windows.h CreateFileW" c_CreateFileW :: CWString -> Word32 -> Word32 -> Ptr () -> Word32 -> Word32 -> Ptr () -> IO (Ptr ())+foreign import CALLCONV unsafe "Windows.h CloseHandle" c_CloseHandle :: Ptr () -> IO Bool+foreign import CALLCONV unsafe "Windows.h GetLastError" c_GetLastError :: IO Word32++c_GENERIC_WRITE = 0x40000000 :: Word32+c_GENERIC_READ  = 0x80000000 :: Word32+c_FILE_SHARE_NONE = 0 :: Word32+c_OPEN_ALWAYS = 4 :: Word32+c_FILE_ATTRIBUTE_NORMAL = 0x80 :: Word32+c_INVALID_HANDLE_VALUE = intPtrToPtr (-1)+c_ERROR_SHARING_VIOLATION = 32+#endif++usingLockFile :: Cleanup -> FilePath -> IO ()++#ifdef mingw32_HOST_OS++usingLockFile b file = do+    createDirectoryRecursive $ takeDirectory file+    let open = withCWString file $ \cfile ->+            c_CreateFileW cfile (c_GENERIC_READ .|. c_GENERIC_WRITE) c_FILE_SHARE_NONE nullPtr c_OPEN_ALWAYS c_FILE_ATTRIBUTE_NORMAL nullPtr+    h <- allocate b open (void . c_CloseHandle)+    when (h == c_INVALID_HANDLE_VALUE) $ do+        err <- c_GetLastError+        errorIO $ "Shake failed to acquire a file lock on " ++ file ++ "\n" +++                    (if err == c_ERROR_SHARING_VIOLATION+                        then "ERROR_SHARING_VIOLATION - Shake is probably already running."+                        else "Code " ++ show err ++ ", unknown reason for failure.")++#else++usingLockFile cleanup file = do+    createDirectoryRecursive $ takeDirectory file+    tryIO $ writeFile file ""++    fd <- allocate cleanup (openSimpleFd file ReadWrite) closeFd+    let lock = (WriteLock, AbsoluteSeek, 0, 0)+    setLock fd lock `catchIO` \e -> do+        res <- getLock fd lock+        errorIO $ "Shake failed to acquire a file lock on " ++ file ++ "\n" +++                    (case res of+                        Nothing -> ""+                        Just (pid, _) -> "Shake process ID " ++ show pid ++ " is using this lock.\n") +++                    show e++#ifndef MIN_VERSION_unix+#define MIN_VERSION_unix(a,b,c) 0+#endif+#if MIN_VERSION_unix(2,8,0)+openSimpleFd file mode = openFd file mode defaultFileFlags+#else+openSimpleFd file mode = openFd file mode Nothing defaultFileFlags+#endif++#endif
+ src/General/GetOpt.hs view
@@ -0,0 +1,64 @@++module General.GetOpt(+    OptDescr(..), ArgDescr(..),+    getOpt,+    fmapFmapOptDescr,+    showOptDescr,+    mergeOptDescr,+    removeOverlap,+    optionsEnum,+    optionsEnumDesc+    ) where++import qualified System.Console.GetOpt as O+import System.Console.GetOpt hiding (getOpt)+import qualified Data.HashSet as Set+import Data.Maybe+import Data.Either+import Data.List.Extra+++getOpt :: [OptDescr (Either String a)] -> [String] -> ([a], [String], [String])+getOpt opts args = (flagGood, files, flagBad ++ errs)+    where (flags, files, errs) = O.getOpt O.Permute opts args+          (flagBad, flagGood) = partitionEithers flags+++fmapFmapOptDescr :: (a -> b) -> OptDescr (Either String a) -> OptDescr (Either String b)+fmapFmapOptDescr f = fmap (fmap f)+++showOptDescr :: [OptDescr a] -> [String]+showOptDescr xs = concat+    [ if nargs <= 26 then ["  " ++ args ++ replicate (28 - nargs) ' ' ++ desc]+                     else ["  " ++ args, replicate 30 ' ' ++ desc]+    | Option s l arg desc <- xs+    , let args = intercalate ", " $ map (short arg) s ++ map (long arg) l+    , let nargs = length args]+    where short NoArg{} x = "-" ++ [x]+          short (ReqArg _ b) x = "-" ++ [x] ++ " " ++ b+          short (OptArg _ b) x = "-" ++ [x] ++ "[" ++ b ++ "]"+          long NoArg{} x = "--" ++ x+          long (ReqArg _ b) x = "--" ++ x ++ "=" ++ b+          long (OptArg _ b) x = "--" ++ x ++ "[=" ++ b ++ "]"+++-- | Remove flags from the first field that are present in the second+removeOverlap :: [OptDescr b] -> [OptDescr a] -> [OptDescr a]+removeOverlap bad = mapMaybe f+    where+        short = Set.fromList $ concat [x | Option x _ _ _ <- bad]+        long  = Set.fromList $ concat [x | Option _ x _ _ <- bad]+        f (Option a b c d) | null a2 && null b2 = Nothing+                           | otherwise = Just $ Option a2 b2 c d+            where a2 = filter (not . flip Set.member short) a+                  b2 = filter (not . flip Set.member long) b++mergeOptDescr :: [OptDescr (Either String a)] -> [OptDescr (Either String b)] -> [OptDescr (Either String (Either a b))]+mergeOptDescr xs ys = map (fmapFmapOptDescr Left) xs ++ map (fmapFmapOptDescr Right) ys++optionsEnum :: (Enum a, Bounded a, Show a) => [OptDescr (Either String a)]+optionsEnum = optionsEnumDesc [(x, "Flag " ++ lower (show x) ++ ".") | x <- enumerate]++optionsEnumDesc :: Show a => [(a, String)] -> [OptDescr (Either String a)]+optionsEnumDesc xs = [Option "" [lower $ show x] (NoArg $ Right x) d | (x,d) <- xs]
+ src/General/Ids.hs view
@@ -0,0 +1,157 @@+{-# LANGUAGE RecordWildCards, BangPatterns, GADTs, UnboxedTuples #-}++-- Note that argument order is more like IORef than Map, because its mutable+module General.Ids(+    Ids, Id(..),+    empty, insert, lookup, fromList,+    null, size, sizeUpperBound,+    forWithKeyM_, forCopy, forMutate,+    toList, elems, toMap+    ) where++import Data.IORef.Extra+import Data.Primitive.Array hiding (fromList)+import Control.Exception+import General.Intern(Id(..))+import Control.Monad.Extra+import Data.List.Extra(zipFrom)+import Data.Maybe+import Data.Functor+import qualified Data.HashMap.Strict as Map+import Prelude hiding (lookup, null)+import GHC.IO(IO(..))+import GHC.Exts(RealWorld)+++newtype Ids a = Ids (IORef (S a))++data S a = S+    {capacity :: {-# UNPACK #-} !Int -- ^ Number of entries in values, initially 0+    ,used :: {-# UNPACK #-} !Int -- ^ Capacity that has been used, assuming no gaps from index 0, initially 0+    ,values :: {-# UNPACK #-} !(MutableArray RealWorld (Maybe a))+    }+++empty :: IO (Ids a)+empty = do+    let capacity = 0+    let used = 0+    values <- newArray capacity Nothing+    Ids <$> newIORef S{..}++fromList :: [a] -> IO (Ids a)+fromList xs = do+    let capacity = length xs+    let used = capacity+    values <- newArray capacity Nothing+    forM_ (zipFrom 0 xs) $ \(i, x) ->+        writeArray values i $ Just x+    Ids <$> newIORef S{..}++sizeUpperBound :: Ids a -> IO Int+sizeUpperBound (Ids ref) = do+    S{..} <- readIORef ref+    pure used+++size :: Ids a -> IO Int+size (Ids ref) = do+    S{..} <- readIORef ref+    let go !acc i+            | i < 0 = pure acc+            | otherwise = do+                v <- readArray values i+                if isJust v then go (acc+1) (i-1) else go acc (i-1)+    go 0 (used-1)+++toMap :: Ids a -> IO (Map.HashMap Id a)+toMap ids = do+    mp <- Map.fromList <$> toListUnsafe ids+    pure $! mp++forWithKeyM_ :: Ids a -> (Id -> a -> IO ()) -> IO ()+forWithKeyM_ (Ids ref) f = do+    S{..} <- readIORef ref+    let go !i | i >= used = pure ()+              | otherwise = do+                v <- readArray values i+                whenJust v $ f $ Id $ fromIntegral i+                go $ i+1+    go 0++forCopy :: Ids a -> (a -> b) -> IO (Ids b)+forCopy (Ids ref) f = do+    S{..} <- readIORef ref+    values2 <- newArray capacity Nothing+    let go !i | i >= used = pure ()+              | otherwise = do+                v <- readArray values i+                whenJust v $ \v -> writeArray values2 i $ Just $ f v+                go $ i+1+    go 0+    Ids <$> newIORef (S capacity used values2)+++forMutate :: Ids a -> (a -> a) -> IO ()+forMutate (Ids ref) f = do+    S{..} <- readIORef ref+    let go !i | i >= used = pure ()+              | otherwise = do+                v <- readArray values i+                whenJust v $ \v -> writeArray values i $! Just $! f v+                go $ i+1+    go 0+++toListUnsafe :: Ids a -> IO [(Id, a)]+toListUnsafe (Ids ref) = do+    S{..} <- readIORef ref++    -- execute in O(1) stack+    -- see https://neilmitchell.blogspot.co.uk/2015/09/making-sequencemapm-for-io-take-o1-stack.html+    let index _ i | i >= used = []+        index r i | IO io <- readArray values i = case io r of+            (# r, Nothing #) -> index r (i+1)+            (# r, Just v  #) -> (Id $ fromIntegral i, v) : index r (i+1)++    IO $ \r -> (# r, index r 0 #)+++toList :: Ids a -> IO [(Id, a)]+toList ids = do+    xs <- toListUnsafe ids+    let demand (_:xs) = demand xs+        demand [] = ()+    evaluate $ demand xs+    pure xs++elems :: Ids a -> IO [a]+elems ids = map snd <$> toList ids++null :: Ids a -> IO Bool+null ids = (== 0) <$> sizeUpperBound ids+++insert :: Ids a -> Id -> a -> IO ()+insert (Ids ref) (Id i) v = do+    S{..} <- readIORef ref+    let ii = fromIntegral i+    if ii < capacity then do+        writeArray values ii $ Just v+        when (ii >= used) $ writeIORef' ref S{used=ii+1,..}+     else do+        c2<- pure $ max (capacity * 2) (ii + 10000)+        v2 <- newArray c2 Nothing+        copyMutableArray v2 0 values 0 capacity+        writeArray v2 ii $ Just v+        writeIORef' ref $ S c2 (ii+1) v2++lookup :: Ids a -> Id -> IO (Maybe a)+lookup (Ids ref) (Id i) = do+    S{..} <- readIORef ref+    let ii = fromIntegral i+    if ii < used then+        readArray values ii+     else+        pure Nothing
+ src/General/Intern.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# OPTIONS_GHC -Wno-unused-imports #-} -- Required since foldl' moves to the prelude++module General.Intern(+    Intern, Id(..),+    empty, insert, add, lookup, toList, fromList+    ) where++import Development.Shake.Classes+import Foreign.Storable+import Data.Word+import qualified Data.HashMap.Strict as Map+import Data.List(foldl')+import Prelude hiding (lookup)+++-- Invariant: The first field is the highest value in the Map+data Intern a = Intern {-# UNPACK #-} !Word32 !(Map.HashMap a Id)++newtype Id = Id Word32+    deriving (Eq,Hashable,Ord,Binary,Show,NFData,Storable)++empty :: Intern a+empty = Intern 0 Map.empty+++insert :: (Eq a, Hashable a) => a -> Id -> Intern a -> Intern a+insert k v@(Id i) (Intern n mp) = Intern (max n i) $ Map.insert k v mp+++add :: (Eq a, Hashable a) => a -> Intern a -> (Intern a, Id)+add k (Intern v mp) = (Intern v2 $ Map.insert k (Id v2) mp, Id v2)+    where v2 = v + 1+++lookup :: (Eq a, Hashable a) => a -> Intern a -> Maybe Id+lookup k (Intern _ mp) = Map.lookup k mp+++toList :: Intern a -> [(a, Id)]+toList (Intern _ mp) = Map.toList mp+++fromList :: (Eq a, Hashable a) => [(a, Id)] -> Intern a+fromList xs = Intern (foldl' max 0 [i | (_, Id i) <- xs]) (Map.fromList xs)
+ src/General/ListBuilder.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE DeriveFunctor, GeneralizedNewtypeDeriving #-}++module General.ListBuilder(+    ListBuilder, runListBuilder, newListBuilder,+    Tree(..), flattenTree, unflattenTree+    ) where++import Data.Semigroup+import Prelude+++-- ListBuilder is opaque outside this module+newtype ListBuilder a = ListBuilder (Tree a)+    deriving (Semigroup, Monoid, Functor)++data Tree a+    = Empty+    | Leaf a+    | Branch (Tree a) (Tree a)+      deriving (Functor,Eq,Ord,Show)+++instance Semigroup (Tree a) where+    Empty <> x = x+    x <> Empty = x+    x <> y = Branch x y++instance Monoid (Tree a) where+    mempty = Empty+    mappend = (<>)++flattenTree :: Tree a -> [a]+flattenTree x = f x []+    where+        f Empty acc = acc+        f (Leaf x) acc = x : acc+        f (Branch x y) acc = f x (f y acc)++unflattenTree :: Tree a -> [b] -> Tree b+unflattenTree t xs = fst $ f t xs+    where+        f Empty xs = (Empty, xs)+        f Leaf{} (x:xs) = (Leaf x, xs)+        f (Branch a b) xs = (Branch a2 b2, xs3)+            where (a2, xs2) = f a xs+                  (b2, xs3) = f b xs2++newListBuilder :: a -> ListBuilder a+newListBuilder = ListBuilder . Leaf++runListBuilder :: ListBuilder a -> [a]+runListBuilder (ListBuilder x) = flattenTree x
+ src/General/Makefile.hs view
@@ -0,0 +1,40 @@++module General.Makefile(parseMakefile) where++import qualified Data.ByteString.Char8 as BS+import Data.Char+++endsSlash :: BS.ByteString -> Bool+endsSlash = BS.isSuffixOf (BS.singleton '\\')++wordsMakefile :: BS.ByteString -> [BS.ByteString]+wordsMakefile = f . BS.splitWith isSpace+    where+        f (x:xs) | BS.null x = f xs+        f (x:y:xs) | endsSlash x = f $ BS.concat [BS.init x, BS.singleton ' ', y] : xs+        f (x:xs) = x : f xs+        f [] = []++parseMakefile :: BS.ByteString -> [(BS.ByteString, [BS.ByteString])]+parseMakefile = concatMap f . join . linesCR+    where+        join xs = case span endsSlash xs of+            ([], []) -> []+            (xs, []) -> [BS.unwords $ map BS.init xs]+            ([], y:ys) -> y : join ys+            (xs, y:ys) -> BS.unwords (map BS.init xs ++ [y]) : join ys++        f x = [(a, wordsMakefile $ BS.drop 1 b) | a <- wordsMakefile a]+            where (a,b) = BS.break (== ':') $ BS.takeWhile (/= '#') x+++-- | This is a hot-spot, so optimised+linesCR :: BS.ByteString -> [BS.ByteString]+linesCR x = case BS.split '\n' x of+    x:xs | Just ('\r',x) <- unsnoc x -> x : map (\x -> case unsnoc x of Just ('\r',x) -> x; _ -> x) xs+    xs -> xs+    where+        -- the ByteString unsnoc was introduced in a newer version+        unsnoc x | BS.null x = Nothing+                 | otherwise = Just (BS.last x, BS.init x)
+ src/General/Pool.hs view
@@ -0,0 +1,169 @@+{-# LANGUAGE TupleSections #-}++-- | Thread pool implementation. The three names correspond to the following+--   priority levels (highest to lowest):+--+-- * 'addPoolException' - things that probably result in a build error,+--   so kick them off quickly.+--+-- * 'addPoolResume' - things that started, blocked, and may have open+--   resources in their closure.+--+-- * 'addPoolStart' - rules that haven't yet started.+--+-- * 'addPoolBatch' - rules that might batch if other rules start first.+module General.Pool(+    Pool, runPool,+    addPool, PoolPriority(..),+    increasePool, keepAlivePool+    ) where++import Control.Concurrent.Extra+import System.Time.Extra+import Control.Exception+import Control.Monad.Extra+import General.Timing+import General.Thread+import qualified Data.Heap as Heap+import qualified Data.HashSet as Set+import Data.IORef.Extra+import System.Random+++---------------------------------------------------------------------+-- THREAD POOL++{-+Must keep a list of active threads, so can raise exceptions in a timely manner+If any worker throws an exception, must signal to all the other workers+-}++data S = S+    {alive :: !Bool -- True until there's an exception, after which don't spawn more tasks+    ,threads :: !(Set.HashSet Thread) -- IMPORTANT: Must be strict or we leak thread stacks+    ,threadsLimit :: {-# UNPACK #-} !Int -- user supplied thread limit, Set.size threads <= threadsLimit+    ,threadsCount :: {-# UNPACK #-} !Int -- Set.size threads, but in O(1)+    ,threadsMax :: {-# UNPACK #-} !Int -- high water mark of Set.size threads (accounting only)+    ,threadsSum :: {-# UNPACK #-} !Int -- number of threads we have been through (accounting only)+    ,rand :: IO Int -- operation to give us the next random Int+    ,todo :: !(Heap.Heap (Heap.Entry (PoolPriority, Int) (IO ()))) -- operations waiting a thread+    }+++emptyS :: Int -> Bool -> IO S+emptyS n deterministic = do+    rand <- if not deterministic then pure randomIO else do+        ref <- newIORef 0+        -- no need to be thread-safe - if two threads race they were basically the same time anyway+        pure $ do i <- readIORef ref; writeIORef' ref (i+1); pure i+    pure $ S True Set.empty n 0 0 0 rand Heap.empty+++data Pool = Pool+    !(Var S) -- Current state, 'alive' = False to say we are aborting+    !(Barrier (Either SomeException S)) -- Barrier to signal that we are finished+++withPool :: Pool -> (S -> IO (S, IO ())) -> IO ()+withPool (Pool var _) f = join $ modifyVar var $ \s ->+    if alive s then f s else pure (s, pure ())++withPool_ :: Pool -> (S -> IO S) -> IO ()+withPool_ pool act = withPool pool $ fmap (, pure()) . act+++worker :: Pool -> IO ()+worker pool = withPool pool $ \s -> pure $ case Heap.uncons $ todo s of+    Nothing -> (s, pure ())+    Just (Heap.Entry _ now, todo2) -> (s{todo = todo2}, now >> worker pool)++-- | Given a pool, and a function that breaks the S invariants, restore them.+--   They are only allowed to touch threadsLimit or todo.+--   Assumes only requires spawning a most one job (e.g. can't increase the pool by more than one at a time)+step :: Pool -> (S -> IO S) -> IO ()+-- mask_ is so we don't spawn and not record it+step pool@(Pool _ done) op = mask_ $ withPool_ pool $ \s -> do+    s <- op s+    case Heap.uncons $ todo s of+        Just (Heap.Entry _ now, todo2) | threadsCount s < threadsLimit s -> do+            -- spawn a new worker+            t <- newThreadFinally (now >> worker pool) $ \t res -> case res of+                Left e -> withPool_ pool $ \s -> do+                    signalBarrier done $ Left e+                    pure (remThread t s){alive = False}+                Right _ ->+                    step pool $ pure . remThread t+            pure (addThread t s){todo = todo2}+        Nothing | threadsCount s == 0 -> do+            signalBarrier done $ Right s+            pure s{alive = False}+        _ -> pure s+    where+        addThread t s = s{threads = Set.insert t $ threads s, threadsCount = threadsCount s + 1+                         ,threadsSum = threadsSum s + 1, threadsMax = threadsMax s `max` (threadsCount s + 1)}+        remThread t s = s{threads = Set.delete t $ threads s, threadsCount = threadsCount s - 1}+++-- | Add a new task to the pool. See the top of the module for the relative ordering+--   and semantics.+addPool :: PoolPriority -> Pool -> IO a -> IO ()+addPool priority pool act = step pool $ \s -> do+    i <- rand s+    pure s{todo = Heap.insert (Heap.Entry (priority, i) $ void act) $ todo s}+++data PoolPriority+    = PoolException+    | PoolResume+    | PoolStart+    | PoolBatch+    | PoolDeprioritize Double+      deriving (Eq,Ord)++-- | Temporarily increase the pool by 1 thread. Call the cleanup action to restore the value.+--   After calling cleanup you should requeue onto a new thread.+increasePool :: Pool -> IO (IO ())+increasePool pool = do+    step pool $ \s -> pure s{threadsLimit = threadsLimit s + 1}+    pure $ step pool $ \s -> pure s{threadsLimit = threadsLimit s - 1}+++-- | Make sure the pool cannot run out of tasks (and thus everything finishes) until after the cancel is called.+--   Ensures that a pool that will requeue in time doesn't go idle.+keepAlivePool :: Pool -> IO (IO ())+keepAlivePool pool = do+    bar <- newBarrier+    addPool PoolResume pool $ do+        cancel <- increasePool pool+        waitBarrier bar+        cancel+    pure $ signalBarrier bar ()+++-- | Run all the tasks in the pool on the given number of works.+--   If any thread throws an exception, the exception will be reraised.+runPool :: Bool -> Int -> (Pool -> IO ()) -> IO () -- run all tasks in the pool+runPool deterministic n act = do+    s <- newVar =<< emptyS n deterministic+    done <- newBarrier+    let pool = Pool s done++    -- if someone kills our thread, make sure we kill our child threads+    let cleanup = join $ modifyVar s $ \s -> pure (s{alive=False}, stopThreads $ Set.toList $ threads s)++    let ghc10793 = do+            -- if this thread dies because it is blocked on an MVar there's a chance we have+            -- a better error in the done barrier, and GHC raised the exception wrongly, see:+            -- https://ghc.haskell.org/trac/ghc/ticket/10793+            sleep 1 -- give it a little bit of time for the finally to run+                    -- no big deal, since the blocked indefinitely takes a while to fire anyway+            res <- waitBarrierMaybe done+            case res of+                Just (Left e) -> throwIO e+                _ -> throwIO BlockedIndefinitelyOnMVar+    flip finally cleanup $ handle (\BlockedIndefinitelyOnMVar -> ghc10793) $ do+        addPool PoolStart pool $ act pool+        res <- waitBarrier done+        case res of+            Left e -> throwIO e+            Right s -> addTiming $ "Pool finished (" ++ show (threadsSum s) ++ " threads, " ++ show (threadsMax s) ++ " max)"
+ src/General/Process.hs view
@@ -0,0 +1,238 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RecordWildCards #-}++-- | A wrapping of createProcess to provide a more flexible interface.+module General.Process(+    Buffer, newBuffer, readBuffer,+    process, ProcessOpts(..), Source(..), Destination(..)+    ) where++import Control.Concurrent.Extra+import Control.DeepSeq+import Control.Exception.Extra as C+import Control.Monad.Extra+import Data.List.Extra+import Data.Maybe+import Foreign.C.Error+import System.Exit+import System.IO.Extra+import System.Info.Extra+import System.Process+import System.Time.Extra+import Data.Unique+import Data.IORef.Extra+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy as LBS+import General.Extra+import Development.Shake.Internal.Errors++import GHC.IO.Exception (IOErrorType(..), IOException(..))++---------------------------------------------------------------------+-- BUFFER ABSTRACTION++data Buffer a = Buffer Unique (IORef [a])+instance Eq (Buffer a) where Buffer x _ == Buffer y _ = x == y+instance Ord (Buffer a) where compare (Buffer x _) (Buffer y _) = compare x y++newBuffer :: IO (Buffer a)+newBuffer = liftM2 Buffer newUnique (newIORef [])++addBuffer :: Buffer a -> a -> IO ()+addBuffer (Buffer _ ref) x = atomicModifyIORef_ ref (x:)++readBuffer :: Buffer a -> IO [a]+readBuffer (Buffer _ ref) = reverse <$> readIORef ref+++---------------------------------------------------------------------+-- OPTIONS++data Source+    = SrcFile FilePath+    | SrcString String+    | SrcBytes LBS.ByteString+    | SrcInherit++data Destination+    = DestEcho+    | DestFile FilePath+    | DestString (Buffer String)+    | DestBytes (Buffer BS.ByteString)+      deriving (Eq,Ord)++isDestString DestString{} = True; isDestString _ = False+isDestBytes  DestBytes{}  = True; isDestBytes  _ = False++data ProcessOpts = ProcessOpts+    {poCommand :: CmdSpec+    ,poCwd :: Maybe FilePath+    ,poEnv :: Maybe [(String, String)]+    ,poTimeout :: Maybe Double+    ,poStdin :: [Source]+    ,poStdout :: [Destination]+    ,poStderr :: [Destination]+    ,poAsync :: Bool+    ,poCloseFds :: Bool+    ,poGroup :: Bool+    }+++---------------------------------------------------------------------+-- IMPLEMENTATION++-- | If two buffers can be replaced by one and a copy, do that (only if they start empty)+optimiseBuffers :: ProcessOpts -> IO (ProcessOpts, IO ())+optimiseBuffers po@ProcessOpts{..} = pure (po{poStdout = nubOrd poStdout, poStderr = nubOrd poStderr}, pure ())++stdStream :: (FilePath -> Handle) -> [Destination] -> [Destination] -> StdStream+stdStream _ [DestEcho] _ = Inherit+stdStream file [DestFile x] other | other == [DestFile x] || DestFile x `notElem` other = UseHandle $ file x+stdStream _ _ _ = CreatePipe+++stdIn :: (FilePath -> Handle) -> [Source] -> (StdStream, Handle -> IO ())+stdIn _ [SrcInherit] = (Inherit, const $ pure ())+stdIn file [SrcFile x] = (UseHandle $ file x, const $ pure ())+stdIn file src = (,) CreatePipe $ \h -> ignoreSigPipe $ do+    forM_ src $ \case+        SrcString x -> hPutStr h x+        SrcBytes x -> LBS.hPutStr h x+        SrcFile x -> LBS.hPutStr h =<< LBS.hGetContents (file x)+        SrcInherit -> pure () -- Can't both inherit and set it+    hClose h+++ignoreSigPipe :: IO () -> IO ()+ignoreSigPipe = handleIO $ \e -> case e of+    IOError {ioe_type=ResourceVanished, ioe_errno=Just ioe} | Errno ioe == ePIPE -> pure ()+    _ -> throwIO e+++withExceptions :: IO () -> IO a -> IO a+withExceptions stop go = do+    bar <- newBarrier+    v <- mask $ \unmask -> do+        forkFinally (unmask go) $ signalBarrier bar+        unmask (waitBarrier bar) `onException` do+            forkIO stop+            waitBarrier bar+    either throwIO pure v+++withTimeout :: Maybe Double -> IO () -> IO a -> IO a+withTimeout Nothing _ go = go+withTimeout (Just s) stop go = bracket (forkIO $ sleep s >> stop) killThread $ const go+++cmdSpec :: CmdSpec -> CreateProcess+cmdSpec (ShellCommand x) = shell x+cmdSpec (RawCommand x xs) = proc x xs++++forkWait :: IO a -> IO (IO a)+forkWait a = do+    res <- newEmptyMVar+    _ <- mask $ \restore -> forkIO $ try_ (restore a) >>= putMVar res+    pure $ takeMVar res >>= either throwIO pure+++abort :: Bool -> ProcessHandle -> IO ()+abort poGroup pid = do+    when poGroup $ do+        interruptProcessGroupOf pid+        sleep 3 -- give the process a few seconds grace period to die nicely+    terminateProcess pid+++withFiles :: IOMode -> [FilePath] -> ((FilePath -> Handle) -> IO a) -> IO a+withFiles mode files act = withs (map (`withFile` mode) files) $ \handles ->+    act $ \x -> fromJust $ lookup x $ zipExact files handles+++-- General approach taken from readProcessWithExitCode+process :: ProcessOpts -> IO (ProcessHandle, ExitCode)+process po = do+    (ProcessOpts{..}, flushBuffers) <- optimiseBuffers po+    let outFiles = nubOrd [x | DestFile x <- poStdout ++ poStderr]+    let inFiles = nubOrd [x | SrcFile x <- poStdin]+    withFiles WriteMode outFiles $ \outHandle -> withFiles ReadMode inFiles $ \inHandle -> do+        let cp = (cmdSpec poCommand){cwd = poCwd, env = poEnv, create_group = poGroup, close_fds = poCloseFds+                 ,std_in = fst $ stdIn inHandle poStdin+                 ,std_out = stdStream outHandle poStdout poStderr, std_err = stdStream outHandle poStderr poStdout}+        withCreateProcessCompat cp $ \inh outh errh pid ->+            withTimeout poTimeout (abort poGroup pid) $ withExceptions (abort poGroup pid) $ do++                let streams = [(outh, stdout, poStdout) | Just outh <- [outh], CreatePipe <- [std_out cp]] +++                              [(errh, stderr, poStderr) | Just errh <- [errh], CreatePipe <- [std_err cp]]+                wait <- forM streams $ \(h, hh, dest) -> do+                    -- no point tying the streams together if one is being streamed directly+                    let isTied = not (poStdout `disjoint` poStderr) && length streams == 2+                    let isBinary = any isDestBytes dest || not (any isDestString dest)+                    when isTied $ hSetBuffering h LineBuffering+                    when (DestEcho `elem` dest) $ do+                        buf <- hGetBuffering hh+                        case buf of+                            BlockBuffering{} -> pure ()+                            _ -> hSetBuffering h buf++                    if isBinary then do+                        hSetBinaryMode h True+                        dest<- pure $ flip map dest $ \case+                            DestEcho -> BS.hPut hh+                            DestFile x -> BS.hPut (outHandle x)+                            DestString x -> addBuffer x . (if isWindows then replace "\r\n" "\n" else id) . BS.unpack+                            DestBytes x -> addBuffer x+                        forkWait $ whileM $ do+                            src <- BS.hGetSome h 4096+                            mapM_ ($ src) dest+                            notM $ hIsEOF h+                     else if isTied then do+                        dest<- pure $ flip map dest $ \case+                            DestEcho -> hPutStrLn hh+                            DestFile x -> hPutStrLn (outHandle x)+                            DestString x -> addBuffer x . (++ "\n")+                            DestBytes{} -> throwImpure $ errorInternal "Not reachable due to isBinary condition"+                        forkWait $ whileM $+                            ifM (hIsEOF h) (pure False) $ do+                                src <- hGetLine h+                                mapM_ ($ src) dest+                                pure True+                     else do+                        src <- hGetContents h+                        wait1 <- forkWait $ C.evaluate $ rnf src+                        waits <- forM dest $ \case+                            DestEcho -> forkWait $ hPutStr hh src+                            DestFile x -> forkWait $ hPutStr (outHandle x) src+                            DestString x -> do addBuffer x src; pure $ pure ()+                            DestBytes{} -> throwImpure $ errorInternal "Not reachable due to isBinary condition"+                        pure $ sequence_ $ wait1 : waits++                whenJust inh $ snd $ stdIn inHandle poStdin+                if poAsync then+                    pure (pid, ExitSuccess)+                 else do+                    sequence_ wait+                    flushBuffers+                    res <- waitForProcess pid+                    whenJust outh hClose+                    whenJust errh hClose+                    pure (pid, res)+++---------------------------------------------------------------------+-- COMPATIBILITY++-- available in process-1.4.3.0, GHC ??? (Nov 2015)+-- logic copied directly (apart from Ctrl-C handling magic using internal pieces)+withCreateProcessCompat :: CreateProcess -> (Maybe Handle -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a) -> IO a+withCreateProcessCompat cp act = bracketOnError (createProcess cp) cleanup+    (\(m_in, m_out, m_err, ph) -> act m_in m_out m_err ph)+    where+        cleanup (inh, outh, errh, pid) = do+            terminateProcess pid+            whenJust inh $ ignoreSigPipe . hClose+            whenJust outh hClose+            whenJust errh hClose+            forkIO $ void $ waitForProcess pid
+ src/General/Template.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ViewPatterns #-}++-- Keep using iso8601DateFormat, since the alternative was introduced in time-1.9+-- while GHC 8.6 still has time-1.8.+-- Safe once we no longer support GHC 8.6.+{-# OPTIONS_GHC -Wno-deprecations #-}++#ifdef FILE_EMBED+{-# LANGUAGE TemplateHaskell #-}+#endif++module General.Template(runTemplate) where++import System.FilePath.Posix+import Control.Exception.Extra+import Data.Char+import Data.Time+import System.IO.Unsafe+import Development.Shake.Internal.Paths+import qualified Data.ByteString.Lazy.Char8 as LBS+import qualified Language.Javascript.DGTable as DGTable+import qualified Language.Javascript.Flot as Flot+import qualified Language.Javascript.JQuery as JQuery++#ifdef FILE_EMBED+import Data.FileEmbed+import Language.Haskell.TH.Syntax ( runIO )+#endif++{- HLINT ignore "Redundant bracket" -} -- a result of CPP expansion++-- Very hard to abstract over TH, so we do it with CPP+#ifdef FILE_EMBED+#define FILE(x) (pure (LBS.fromStrict $(embedFile =<< runIO (x))))+#else+#define FILE(x) (LBS.readFile =<< (x))+#endif++libraries :: [(String, IO LBS.ByteString)]+libraries =+    [("jquery.js",            FILE(JQuery.file))+    ,("jquery.dgtable.js",    FILE(DGTable.file))+    ,("jquery.flot.js",       FILE(Flot.file Flot.Flot))+    ,("jquery.flot.stack.js", FILE(Flot.file Flot.FlotStack))+    ]+++-- | Template Engine. Perform the following replacements on a line basis:+--+-- * <script src="foo"></script> ==> <script>[[foo]]</script>+--+-- * <link href="foo" rel="stylesheet" type="text/css" /> ==> <style type="text/css">[[foo]]</style>+runTemplate :: (FilePath -> IO LBS.ByteString) -> LBS.ByteString -> IO LBS.ByteString+runTemplate ask = lbsMapLinesIO f+    where+        link = LBS.pack "<link href=\""+        script = LBS.pack "<script src=\""++        f x | Just file <- lbsStripPrefix script y = do res <- grab file; pure $ LBS.pack "<script>\n" `LBS.append` res `LBS.append` LBS.pack "\n</script>"+            | Just file <- lbsStripPrefix link y = do res <- grab file; pure $ LBS.pack "<style type=\"text/css\">\n" `LBS.append` res `LBS.append` LBS.pack "\n</style>"+            | otherwise = pure x+            where+                y = LBS.dropWhile isSpace x+                grab = asker . takeWhile (/= '\"') . LBS.unpack++        asker o@(splitFileName -> ("lib/",x)) =+            case lookup x libraries of+                Nothing -> errorIO $ "Template library, unknown library: " ++ o+                Just act -> act++        asker "shake.js" = readDataFileHTML "shake.js"+        asker "data/metadata.js" = do+            time <- getCurrentTime+            pure $ LBS.pack $+                "var version = " ++ show shakeVersionString +++                "\nvar generated = " ++ show (formatTime defaultTimeLocale (iso8601DateFormat (Just "%H:%M:%S")) time)+        asker x = ask x++-- Perform a mapM on each line and put the result back together again+lbsMapLinesIO :: (LBS.ByteString -> IO LBS.ByteString) -> LBS.ByteString -> IO LBS.ByteString+-- If we do the obvious @fmap LBS.unlines . mapM f@ then all the monadic actions are run on all the lines+-- before it starts producing the lazy result, killing streaming and having more stack usage.+-- The real solution (albeit with too many dependencies for something small) is a streaming library,+-- but a little bit of unsafePerformIO does the trick too.+lbsMapLinesIO f = pure . LBS.unlines . map (unsafePerformIO . f) . LBS.lines+++---------------------------------------------------------------------+-- COMPATIBILITY++-- available in bytestring-0.10.8.0, GHC 8.0 and above+-- alternative implementation below+lbsStripPrefix :: LBS.ByteString -> LBS.ByteString -> Maybe LBS.ByteString+lbsStripPrefix prefix text = if a == prefix then Just b else Nothing+    where (a,b) = LBS.splitAt (LBS.length prefix) text
+ src/General/Thread.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE ScopedTypeVariables #-}++-- | A bit like 'Fence', but not thread safe and optimised for avoiding taking the fence+module General.Thread(+    withThreadsBoth,+    withThreadSlave,+    allocateThread,+    Thread, newThreadFinally, stopThreads+    ) where++import General.Cleanup+import Data.Hashable+import Control.Concurrent.Extra+import Control.Exception+import General.Extra+import Control.Monad.Extra+++data Thread = Thread ThreadId (Barrier ())++instance Eq Thread where+    Thread a _ == Thread b _ = a == b++instance Hashable Thread where+    hashWithSalt salt (Thread a _) = hashWithSalt salt a++-- | The inner thread is unmasked even if you started masked.+newThreadFinally :: IO a -> (Thread -> Either SomeException a -> IO ()) -> IO Thread+newThreadFinally act cleanup = do+    bar <- newBarrier+    t <- mask_ $ forkIOWithUnmask $ \unmask -> flip finally (signalBarrier bar ()) $ do+        res <- try $ unmask act+        me <- myThreadId+        cleanup (Thread me bar) res+    pure $ Thread t bar+++stopThreads :: [Thread] -> IO ()+stopThreads threads = do+    -- if a thread is in a masked action, killing it may take some time, so kill them in parallel+    bars <- sequence [do forkIO $ killThread t; pure bar | Thread t bar <- threads]+    mapM_ waitBarrier bars+++-- Run both actions. If either throws an exception, both threads+-- are killed and an exception reraised.+-- Not called much, so simplicity over performance (2 threads).+withThreadsBoth :: IO a -> IO b -> IO (a, b)+withThreadsBoth act1 act2 = do+    bar1 <- newBarrier+    bar2 <- newBarrier+    parent <- myThreadId+    ignore <- newVar False+    mask $ \unmask -> do+        t1 <- forkIOWithUnmask $ \unmask -> do+            res1 :: Either SomeException a <- try $ unmask act1+            unlessM (readVar ignore) $ whenLeft res1 $ throwTo parent+            signalBarrier bar1 res1+        t2 <- forkIOWithUnmask $ \unmask -> do+            res2 :: Either SomeException b <- try $ unmask act2+            unlessM (readVar ignore) $ whenLeft res2 $ throwTo parent+            signalBarrier bar2 res2+        res :: Either SomeException (a,b) <- try $ unmask $ do+            Right v1 <- waitBarrier bar1+            Right v2 <- waitBarrier bar2+            pure (v1,v2)+        writeVar ignore True+        killThread t1+        forkIO $ killThread t2+        waitBarrier bar1+        waitBarrier bar2+        either throwIO pure res+++-- | Run an action in a separate thread.+--   After the first action terminates, the thread will be killed.+--   If the action raises an exception it will be rethrown on the parent thread.+withThreadSlave :: IO () -> IO a -> IO a+withThreadSlave slave act = withCleanup $ \cleanup -> do+    allocateThread cleanup slave+    act+++-- | Run the given action in a separate thread.+--   On cleanup, the thread will be killed before continuing.+--   If the action raises an exception it will be rethrown on the parent thread.+allocateThread :: Cleanup -> IO () -> IO ()+allocateThread cleanup act = do+    bar <- newBarrier+    parent <- myThreadId+    ignore <- newVar False+    void $ allocate cleanup+        (mask_ $ forkIOWithUnmask $ \unmask -> do+            res :: Either SomeException () <- try $ unmask act+            unlessM (readVar ignore) $ whenLeft res $ throwTo parent+            signalBarrier bar ()+        )+        (\t -> do writeVar ignore True; killThread t; waitBarrier bar)
+ src/General/Timing.hs view
@@ -0,0 +1,60 @@++module General.Timing(resetTimings, addTiming, getTimings) where++import Data.IORef.Extra+import System.IO.Unsafe+import Data.Tuple.Extra+import Data.List.Extra+import Numeric.Extra+import General.Extra+import System.Time.Extra+++{-# NOINLINE timer #-}+timer :: IO Seconds+timer = unsafePerformIO offsetTime+++{-# NOINLINE timings #-}+timings :: IORef [(Seconds, String)] -- number of times called, newest first+timings = unsafePerformIO $ newIORef []+++resetTimings :: IO ()+resetTimings = do+    now <- timer+    writeIORef timings [(now, "Start")]+++-- | Print all withTiming information and clear it.+getTimings :: IO [String]+getTimings = do+    now <- timer+    old <- atomicModifyIORef timings dupe+    pure $ showTimings now $ reverse old+++addTiming :: String -> IO ()+addTiming msg = do+    now <- timer+    atomicModifyIORef_ timings ((now,msg):)+++showTimings :: Seconds -> [(Seconds, String)] -> [String]+showTimings _ [] = []+showTimings stop times = showGap $+    [(a ++ "  ", showDP 3 b ++ "s  " ++ showPerc b ++ "  " ++ progress b) | (a,b) <- xs] +++    [("Total", showDP 3 sm ++ "s  " ++ showPerc sm ++ "  " ++ replicate 25 ' ')]+    where+        a // b = if b == 0 then 0 else a / b+        showPerc x = let s = show $ floor $ x * 100 // sm in replicate (3 - length s) ' ' ++ s ++ "%"+        progress x = let i = floor $ x * 25 // mx in replicate i '=' ++ replicate (25-i) ' '+        mx = maximum $ map snd xs+        sm = sum $ map snd xs+        xs = [ (name, stop - start)+             | ((start, name), stop) <- zipExact times $ map fst (drop1 times) ++ [stop]]+++showGap :: [(String,String)] -> [String]+showGap xs = [a ++ replicate (n - length a - length b) ' ' ++ b | (a,b) <- xs]+    where n = maximum [length a + length b | (a,b) <- xs]
+ src/General/TypeMap.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE ExistentialQuantification, ConstraintKinds, KindSignatures, GADTs, ScopedTypeVariables, Rank2Types #-}++module General.TypeMap(+    Map, empty, singleton, insert, map, lookup, unionWith, toList, size+    ) where++import qualified Data.HashMap.Strict as Map+import Data.Typeable+import Unsafe.Coerce+import Data.Functor+import qualified Prelude+import Prelude hiding (lookup, map)+++data F f = forall a . F !(f a)++unF :: F f -> f a+unF x = case x of F x -> unsafeCoerce x++newtype Map f = Map (Map.HashMap TypeRep (F f))++empty :: Map f+empty = Map Map.empty++singleton :: Typeable a => f a -> Map f+singleton x = Map $ Map.singleton (typeRep x) (F x)++insert :: Typeable a => f a -> Map f -> Map f+insert x (Map mp) = Map $ Map.insert (typeRep x) (F x) mp++lookup :: forall a f . Typeable a => Map f -> Maybe (f a)+lookup (Map mp) = unF <$> Map.lookup (typeRep (Proxy :: Proxy a)) mp++unionWith :: (forall a . f a -> f a -> f a) -> Map f -> Map f -> Map f+unionWith f (Map mp1) (Map mp2) = Map $ Map.unionWith (\x1 x2 -> F $ f (unF x1) (unF x2)) mp1 mp2++map :: (forall a . f1 a -> f2 a) -> Map f1 -> Map f2+map f (Map mp) = Map $ Map.map (\(F a) -> F $ f a) mp++toList :: (forall a . f a -> b) -> Map f -> [b]+toList f (Map mp) = Prelude.map (\(F a) -> f a) $ Map.elems mp++size :: Map f -> Int+size (Map mp) = Map.size mp
+ src/General/Wait.hs view
@@ -0,0 +1,122 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveFunctor #-}++-- | A bit like 'Fence', but not thread safe and optimised for avoiding taking the fence+module General.Wait(+    Wait(Now,Later), runWait, quickly, fromLater,+    firstJustWaitUnordered, firstLeftWaitUnordered+    ) where++import Control.Monad.Extra+import Control.Monad.IO.Class+import Data.IORef.Extra+import Data.List.Extra+import Data.Primitive.Array+import GHC.Exts(RealWorld)+import Control.Monad.Fail+import Prelude+++runWait :: Monad m => Wait m a -> m (Wait m a)+runWait (Lift x) = runWait =<< x+runWait x = pure x++fromLater :: Monad m => Wait m a -> (a -> m ()) -> m ()+fromLater (Lift x) f = do x <- x; fromLater x f+fromLater (Now x) f = f x+fromLater (Later x) f = x f++quickly :: Functor m => m a -> Wait m a+quickly = Lift . fmap Now++data Wait m a = Now a+              | Lift (m (Wait m a))+              | Later ((a -> m ()) -> m ())+                deriving Functor++instance (Monad m, Applicative m) => Applicative (Wait m) where+    pure = Now+    Now x <*> y = x <$> y+    Lift x <*> y = Lift $ (<*> y) <$> x+    Later x <*> Now y = Later $ \c -> x $ \x -> c $ x y+    -- Note: We pull the Lift from the right BEFORE the Later, to enable parallelism+    Later x <*> Lift y = Lift $ do y <- y; pure $ Later x <*> y+    Later x <*> Later y = Later $ \c -> x $ \x -> y $ \y -> c $ x y++instance (Monad m, Applicative m) => Monad (Wait m) where+    return = pure+    (>>) = (*>)+    Now x >>= f = f x+    Lift x >>= f = Lift $ do x <- x; pure $ x >>= f+    Later x >>= f = Later $ \c -> x $ \x -> do+        x <- runWait $ f x+        case x of+            Now x -> c x+            _ -> fromLater x c++instance (MonadIO m,  Applicative m) => MonadIO (Wait m) where+    liftIO = Lift . liftIO . fmap Now++instance MonadFail m => MonadFail (Wait m) where+    fail = Lift . Control.Monad.Fail.fail++firstJustWaitUnordered :: MonadIO m => (a -> Wait m (Maybe b)) -> [a] -> Wait m (Maybe b)+firstJustWaitUnordered f = go 0 [] . map f+    where+        -- keep a list of those things we might visit later, and ask for each we see in turn+        go :: MonadIO m => Int -> [(Maybe a -> m ()) -> m ()] -> [Wait m (Maybe a)] -> Wait m (Maybe a)+        go !nlater later (x:xs) = case x of+            Now (Just a) -> Now $ Just a+            Now Nothing -> go nlater later xs+            Later l -> go (succ nlater) (l:later) xs+            Lift x -> Lift $ do+                x <- x+                pure $ go nlater later (x:xs)+        go _ [] [] = Now Nothing+        go _ [l] [] = Later l+        go nls ls [] = Later $ \callback -> do+            ref <- liftIO $ newIORef nls+            forM_ ls $ \l -> l $ \r -> do+                old <- liftIO $ readIORef ref+                when (old > 0) $ case r of+                    Just a -> do+                        liftIO $ writeIORef' ref 0+                        callback $ Just a+                    Nothing -> do+                        liftIO $ writeIORef' ref $ old-1+                        when (old == 1) $ callback Nothing+++firstLeftWaitUnordered :: MonadIO m => (a -> Wait m (Either e b)) -> [a] -> Wait m (Either e [b])+firstLeftWaitUnordered f xs = do+        let n = length xs+        mut <- liftIO $ newArray n undefined+        res <- go mut [] $ zipFrom 0 $ map f xs+        case res of+            Just e -> pure $ Left e+            Nothing -> liftIO $ Right <$> mapM (readArray mut) [0..n-1]+    where+        -- keep a list of those things we might visit later, and ask for each we see in turn+        go :: MonadIO m => MutableArray RealWorld b -> [(Int, (Either e b -> m ()) -> m ())] -> [(Int, Wait m (Either e b))] -> Wait m (Maybe e)+        go mut later ((i,x):xs) = case x of+            Now (Left e) -> Now $ Just e+            Now (Right b) -> do+                liftIO $ writeArray mut i b+                go mut later xs+            Later l -> go mut ((i,l):later) xs+            Lift x -> Lift $ do+                x <- x+                pure $ go mut later ((i,x):xs)+        go _ [] [] = Now Nothing+        go mut ls [] = Later $ \callback -> do+            ref <- liftIO $ newIORef $ length ls+            forM_ ls $ \(i,l) -> l $ \r -> do+                old <- liftIO $ readIORef ref+                when (old > 0) $ case r of+                    Left a -> do+                        liftIO $ writeIORef' ref 0+                        callback $ Just a+                    Right v -> do+                        liftIO $ writeArray mut i v+                        liftIO $ writeIORef' ref $ old-1+                        when (old == 1) $ callback Nothing
+ src/Paths.hs view
@@ -0,0 +1,12 @@+-- | Fake cabal module for local building++module Paths_shake(getDataDir, version) where++import Data.Version.Extra++-- If Shake can't find files in the data directory it tries relative to the executable+getDataDir :: IO FilePath+getDataDir = pure "random_path_that_cannot_possibly_exist"++version :: Version+version = makeVersion [0,0]
+ src/Run.hs view
@@ -0,0 +1,55 @@++module Run(main) where++import Development.Ninja.All+import System.Environment+import Development.Shake+import Development.Shake.FilePath+import General.Timing(resetTimings)+import Control.Monad.Extra+import Control.Exception.Extra+import Data.Maybe+import qualified System.Directory as IO+import General.Extra+import General.GetOpt+import System.Process+import System.Exit+import Data.Either.Extra+++main :: IO ()+main = do+    resetTimings+    args <- getArgs+    hsExe <- findFile+        [".shake" </> "shake" <.> exe+        ,"Shakefile.hs","Shakefile.lhs"]+    case hsExe of+        Just file -> do+            (prog,args)<- pure $+                if takeExtension file `elem` [".hs",".lhs"] then ("runhaskell", file:args) else (toNative file, args)+            e <- rawSystem prog args+            when (e /= ExitSuccess) $ exitWith e+        Nothing -> do+            let opts = shakeOptions{shakeThreads=0,shakeCreationCheck=False,shakeNeedDirectory=True}+            let go = shakeArgsWith opts flags $ \opts targets -> do+                        let tool = listToMaybe [x | Tool x <- opts]+                        makefile <- case reverse [x | UseMakefile x <- opts] of+                            x:_ -> pure x+                            _ -> do+                                res <- findFile ["build.ninja"]+                                case res of+                                    Just x -> pure x+                                    Nothing -> errorIO "Could not find `build.ninja'"+                        runNinja go makefile targets tool+            withArgs ("--no-time":args) go++data Flag = UseMakefile FilePath+          | Tool String++flags = [Option "f" ["file","makefile"] (ReqArg (Right . UseMakefile) "FILE") "Read FILE as a makefile."+        ,Option "t" ["tool"] (ReqArg (Right . Tool) "TOOL") "Ninja-compatible tools."+        ]++findFile :: [FilePath] -> IO (Maybe FilePath)+findFile = findM (fmap (fromRight False) . tryIO . IO.doesFileExist)
+ src/Test.hs view
@@ -0,0 +1,187 @@++module Test(main) where++import Control.Exception.Extra+import Control.Monad.Extra+import Data.Maybe+import Data.List.Extra+import System.Directory+import System.Environment+import General.Timing+import Development.Shake.Internal.FileInfo+import Development.Shake.Internal.FileName+import qualified Data.ByteString.Char8 as BS+import Test.Type(sleepFileTimeCalibrate)+import Control.Concurrent.Extra++import qualified Test.Basic+import qualified Test.Batch+import qualified Test.Benchmark+import qualified Test.Builtin+import qualified Test.BuiltinOverride+import qualified Test.C+import qualified Test.Cache+import qualified Test.Cleanup+import qualified Test.CloseFileHandles+import qualified Test.Command+import qualified Test.Config+import qualified Test.Database+import qualified Test.Digest+import qualified Test.Directory+import qualified Test.Docs+import qualified Test.Errors+import qualified Test.Existence+import qualified Test.FileLock+import qualified Test.FilePath+import qualified Test.FilePattern+import qualified Test.Files+import qualified Test.Forward+import qualified Test.History+import qualified Test.Journal+import qualified Test.Lint+import qualified Test.Live+import qualified Test.Manual+import qualified Test.Match+import qualified Test.Monad+import qualified Test.Ninja+import qualified Test.Oracle+import qualified Test.OrderOnly+import qualified Test.Parallel+import qualified Test.Pool+import qualified Test.Progress+import qualified Test.Random+import qualified Test.Rebuild+import qualified Test.Reschedule+import qualified Test.Resources+import qualified Test.Self+import qualified Test.SelfMake+import qualified Test.Tar+import qualified Test.Targets+import qualified Test.Thread+import qualified Test.Tup+import qualified Test.Unicode+import qualified Test.Util+import qualified Test.Verbosity+import qualified Test.Version++import qualified Run+++fakes = ["clean" * clean, "test" * test, "make" * makefile, "filetime" * filetime]+    where (*) = (,)++mains =+    ["basic" * Test.Basic.main+    ,"batch" * Test.Batch.main+    ,"benchmark" * Test.Benchmark.main+    ,"builtin" * Test.Builtin.main+    ,"builtinOverride" * Test.BuiltinOverride.main+    ,"c" * Test.C.main+    ,"cache" * Test.Cache.main+    ,"cleanup" * Test.Cleanup.main+    ,"closefilehandles" * Test.CloseFileHandles.main+    ,"command" * Test.Command.main+    ,"config" * Test.Config.main+    ,"database" * Test.Database.main+    ,"digest" * Test.Digest.main+    ,"directory" * Test.Directory.main+    ,"docs" * Test.Docs.main+    ,"errors" * Test.Errors.main+    ,"existence" * Test.Existence.main+    ,"filelock" * Test.FileLock.main+    ,"filepath" * Test.FilePath.main+    ,"filepattern" * Test.FilePattern.main+    ,"files" * Test.Files.main+    ,"forward" * Test.Forward.main+    ,"history" * Test.History.main+    ,"journal" * Test.Journal.main+    ,"lint" * Test.Lint.main+    ,"live" * Test.Live.main+    ,"manual" * Test.Manual.main+    ,"match" * Test.Match.main+    ,"monad" * Test.Monad.main+    ,"ninja" * Test.Ninja.main+    ,"oracle" * Test.Oracle.main+    ,"orderonly" * Test.OrderOnly.main+    ,"parallel" * Test.Parallel.main+    ,"pool" * Test.Pool.main+    ,"progress" * Test.Progress.main+    ,"random" * Test.Random.main+    ,"rebuild" * Test.Rebuild.main+    ,"reschedule" * Test.Reschedule.main+    ,"resources" * Test.Resources.main+    ,"self" * Test.Self.main+    ,"selfmake" * Test.SelfMake.main+    ,"tar" * Test.Tar.main+    ,"targets" * Test.Targets.main+    ,"thread" * Test.Thread.main+    ,"tup" * Test.Tup.main+    ,"unicode" * Test.Unicode.main+    ,"util" * Test.Util.main+    ,"verbosity" * Test.Verbosity.main+    ,"version" * Test.Version.main]+    where (*) = (,)+++main :: IO ()+main = do+    resetTimings+    xs <- getArgs+    case flip lookup (fakes ++ mains) =<< listToMaybe xs of+        _ | null xs -> do+            putStrLn "******************************************************************"+            putStrLn "** Running shake test suite, run with '--help' to see arguments **"+            putStrLn "******************************************************************"+            unlessM (doesFileExist "shake.cabal") $ do+                putStrLn ""+                errorIO "\nERROR: Must run the test suite from a directory containing the Shake repo."+            withArgs ["test"] main+            withArgs ["random","test","3m"] main+        Nothing -> putStrLn $ unlines+            ["Welcome to the Shake demo"+            ,""+            ,unwords $ "Modes:" : map fst fakes+            ,unwords $ "Demos:" : map fst mains+            ,""+            ,"As an example, try:"+            ,""+            ,"  shake-test self --jobs=2 --trace"+            ,""+            ,"Which will build Shake, using Shake, on 2 threads."+            ,"You must run the test suite from a directory containing the Shake repo."+            ]+        Just main -> main =<< sleepFileTimeCalibrate "output/calibrate"+++makefile :: IO () -> IO ()+makefile _ = do+    args <- getArgs+    withArgs (drop1 args) Run.main+++filetime :: IO () -> IO ()+filetime _ = do+    args <- getArgs+    addTiming "Reading files"+    files <- concatForM (drop1 args) $ \file ->+        BS.lines . BS.filter (/= '\r') <$> BS.readFile file+    let n = length files+    evaluate n+    addTiming "Modtime"+    let (a,bcd) = splitAt (n `div` 4) files+    let (b,cd) = splitAt (n `div` 4) bcd+    let (c,d) = splitAt (n `div` 4) cd+    vars <- forM [a,b,c,d] $ \xs ->+        onceFork $ mapM_ (getFileInfo False . fileNameFromByteString) xs+    sequence_ vars+++clean :: IO () -> IO ()+clean extra = sequence_ [withArgs [name,"clean"] $ main extra | (name,main) <- mains]+++test :: IO () -> IO ()+test yield = do+    args <- getArgs+    flip onException (putStrLn "TESTS FAILED") $+        sequence_ [withArgs (name:"test":drop1 args) $ test yield | (name,test) <- mains, name /= "random"]
+ src/Test/Basic.hs view
@@ -0,0 +1,219 @@++module Test.Basic(main) where++import Development.Shake+import System.FilePath+import Test.Type+import System.Directory as IO+import Data.List+import Control.Monad+import General.Extra+++main = testBuild test $ do+    "AB.txt" %> \out -> do+        need ["A.txt", "B.txt"]+        text1 <- readFile' "A.txt"+        text2 <- readFile' "B.txt"+        writeFile' out $ text1 ++ text2++    "twice.txt" %> \out -> do+        let src = "once.txt"+        need [src, src]+        copyFile' src out++    "once.txt" %> \out -> do+        src <- readFile' "zero.txt"+        writeFile' out src++    phonys $ \x -> if x /= "halfclean" then Nothing else Just $+        removeFilesAfter "dir" ["//*e.txt"]++    phony "cleaner" $+        removeFilesAfter "dir" ["//*"]++    phony "cleandb" $+        removeFilesAfter "." [".shake.database"]++    phony "configure" $+        liftIO $ appendFile "configure" "1"++    phony "install" $ do+        need ["configure","once.txt"]+        liftIO $ appendFile "install" "1"++    phony "duplicate1" $ need ["duplicate2","duplicate3"]+    phony "duplicate2" $ need ["duplicate3"]+    phony "duplicate3" $ liftIO $ appendFile "duplicate" "1"++    phony "dummy" $+        liftIO $ appendFile "dummy" "1"++    phony "threads" $ do+        x <- getShakeOptions+        writeFile' "threads.txt" $ show $ shakeThreads x++    phony ("slash" </> "platform") $ pure ()+    phony "slash/forward" $ pure ()++    phony "options" $ do+        opts <- getShakeOptions+        putInfo $ show opts++    "dummer.txt" %> \out -> do+        need ["dummy","dummy"]+        need ["dummy"]+        liftIO $ appendFile out "1"++    r <- newResource ".log file" 1+    let trace x = withResource r 1 $ liftIO $ appendFile ".log" x+    "*.par" %> \out -> do+        trace "["+        (if "unsafe" `isInfixOf` out then unsafeExtraThread else id) $ liftIO $ sleep 0.1+        trace "]"+        writeFile' out out++    "sep" </> "1.txt" %> \out -> writeFile' out ""+    "sep/2.txt" %> \out -> writeFile' out ""+    ["sep" </> "3.txt", "sep" </> "4.txt", "sep" </> "5.*", "sep/6.txt"] |%> \out -> writeFile' out ""+    ["sep" </> "7.txt"] |%> \out -> writeFile' out ""++    "ids/source" %> \_ -> pure ()+    "ids/out" %> \out -> do need =<< readFileLines "ids/source"; writeFile' out ""+    "ids/*" %> \out -> do alwaysRerun; trace (takeFileName out); writeFile' out $ takeFileName out++    "rerun" %> \out -> do alwaysRerun; liftIO $ appendFile out "."++    phony "foo" $+        liftIO $ createDirectoryRecursive "foo"++    phony "ordering2" $+        liftIO $ appendFile "order.log" "X"+    phony "ordering" $ do+        liftIO $ appendFile "order.log" "Y"+        need ["ordering2"]++test build = do+    build ["clean"]+    writeFile "A.txt" "AAA"+    writeFile "B.txt" "BBB"+    build ["AB.txt","--sleep"]+    assertContents "AB.txt" "AAABBB"+    appendFile "A.txt" "aaa"+    build ["AB.txt"]+    assertContents "AB.txt" "AAAaaaBBB"+    removeFile "AB.txt"+    build ["AB.txt"]+    assertContents "AB.txt" "AAAaaaBBB"++    writeFile "zero.txt" "xxx"+    build ["twice.txt","--sleep"]+    assertContents "twice.txt" "xxx"+    writeFile "zero.txt" "yyy"+    build ["once.txt","--sleep"]+    assertContents "twice.txt" "xxx"+    assertContents "once.txt" "yyy"+    writeFile "zero.txt" "zzz"+    build ["once.txt","twice.txt","--sleep"]+    assertContents "twice.txt" "zzz"+    assertContents "once.txt" "zzz"++    removeFile "twice.txt"+    build ["twice.txt"]+    assertContents "twice.txt" "zzz"++    show shakeOptions === show shakeOptions+    build ["options"]++    createDirectoryRecursive "dir"+    writeFile "dir/ae.txt" ""+    writeFile "dir/ea.txt" ""+    build ["halfclean"]+    assertBoolIO (IO.doesDirectoryExist "dir") "Directory should exist, cleaner should not have removed it"++    build ["cleaner"]+    sleep 1 -- sometimes takes a while for the file system to notice+    assertBoolIO (not <$> IO.doesDirectoryExist "dir") "Directory should not exist, cleaner should have removed it"++    assertBoolIO (IO.doesFileExist ".shake.database") "Precondition not met"+    build ["cleandb"]+    assertBoolIO (not <$> IO.doesFileExist ".shake.database") "Postcondition not met"++    writeFile "zero.txt" ""+    writeFile "configure" ""+    writeFile "install" ""+    build ["configure"]+    build ["install"]+    build ["install"]+    assertContents "configure" "111"+    assertContents "install" "11"++    build ["dummy"]+    assertContents "dummy" "1"+    build ["dummy"]+    assertContents "dummy" "11"+    build ["dummy","dummy"]+    assertContents "dummy" "111"++    writeFile "dummer.txt" ""+    build ["dummer.txt"]+    assertContents "dummer.txt" "1"+    build ["dummer.txt"]+    assertContents "dummer.txt" "11"++    build ["1.par","2.par","-j1"]+    assertContents ".log" "[][]"+    writeFile ".log" ""+    build ["3.par","4.par","-j2"]+    assertContents ".log" "[[]]"+    writeFile ".log" ""+    processors <- getProcessorCount+    putStrLn $ "getProcessorCount returned " ++ show processors+    when (processors > 1) $ do+        build ["5.par","6.par","-j0"]+        assertContents ".log" "[[]]"++    writeFile ".log" ""+    build ["unsafe1.par","unsafe2.par","-j2"]+    assertContents ".log" "[[]]"++    build ["threads","-j3"]+    assertContents "threads.txt" "3"+    build ["threads","-j0"]+    assertContents "threads.txt" (show processors)++    writeFile "duplicate" ""+    build ["duplicate1","duplicate3"]+    assertContents "duplicate" "1"++    build $ concat [["sep/" ++ show i ++ ".txt", "sep" </> show i ++ ".txt"] | i <- [1..7]]++    build ["slash" </> "platform","slash" </> "forward"]+    build ["slash/platform","slash/forward"]++    createDirectoryRecursive "ids"+    writeFile "ids/source" "ids/a"+    build ["ids/out","--sleep"]+    writeFile ".log" ""+    writeFile "ids/source" "ids/b"+    build ["ids/out","-j4"]+    -- if you collapse depends to [Id] then this ends up asking for the stale 'a'+    assertContents ".log" "b"++    writeFile "rerun" ""+    build ["rerun"]+    assertContents "rerun" "."+    build ["rerun","rerun"]+    assertContents "rerun" ".."++    build ["foo"]+    build ["foo"]++    build [] -- should say "no want/action statements, nothing to do" (checked manually)++    -- #523, #524 - phony children should not run first+    writeFile "order.log" ""+    build ["ordering"]+    assertContents "order.log" "YX"+    build ["ordering"]+    assertContents "order.log" "YXYX"
+ src/Test/Batch.hs view
@@ -0,0 +1,109 @@++module Test.Batch(main) where++import Development.Shake+import Development.Shake.FilePath+import System.Directory+import Data.List+import General.Extra+import Test.Type+import Control.Monad+++main = testBuild test $ do+    let inp x = x -<.> "in"+    file <- newResource "log.txt" 1+    batch 3 ("*.out" %>) (\out -> do need [inp out]; pure out) $ \outs -> do+        liftIO $ assertBool (length outs <= 3) "length outs <= 3"+        withResource file 1 $ liftIO $ appendFile "log.txt" $ show (length outs) ++ "\n"+        putInfo $ "Building batch: " ++ unwords outs+        forM_ outs $ \out -> liftIO $ copyFile (inp out) out+    want [show i <.> "out" | i <- [1..6]]++    "ABn.txt" %> \out -> do+        xs <- needHasChanged ["An.txt", "Bn.txt"]+        writeFileLines out xs++    ["An", "Bn"] &?%> \outs -> do+        xs <- needHasChanged $ map (-<.> "in") outs+        os <- mapM resultHasChanged outs+        forM_ (zip outs os) $ \(out, o) ->+            when (o || (out -<.> "in" `elem` xs)) $+                writeFile' out "1"++    "On" %> \out -> do+        xs <- needHasChanged ["An", "Bn"]+        o <- resultHasChanged out+        writeFileLines out $ xs ++ ["On" | o]++    batch maxBound ("batch_max.*" %>) pure $ \outs ->+        forM_ outs $ \out -> writeFile' out $ show $ length outs++    phony "sleep2" $ liftIO $ sleep 2+    batch 2 ("batch_profile.*" %>) (\x -> when ("1" `isSuffixOf` x) (liftIO $ sleep 1) >> pure x) $ \outs -> do+        liftIO $ sleep 2+        need ["sleep2"]+        forM_ outs $ \out -> writeFile' out ""+++test build = do+    forM_ [1..6] $ \i -> writeFile (show i <.> "in") $ show i+    build ["--sleep","-j2"]+    assertBoolIO (do src <- readFile "log.txt"; pure $ length (lines src) < 6) "some batching"+    writeFile "log.txt" ""+    writeFile "2.in" "22"+    writeFile "5.in" "55"+    build []+    assertContents "log.txt" "2\n"++    writeFile "An.txt" "1"+    writeFile "Bn.txt" "1"+    build ["ABn.txt", "--sleep"]+    assertContents "ABn.txt" "An.txt\nBn.txt\n"+    writeFile "An.txt" "1"+    build ["ABn.txt", "--sleep"]+    assertContents "ABn.txt" "An.txt\n"+    writeFile "Bn.txt" "1"+    build ["ABn.txt", "--sleep"]+    assertContents "ABn.txt" "Bn.txt\n"+    build ["ABn.txt", "--sleep"]+    assertContents "ABn.txt" "Bn.txt\n"+    writeFile "ABn.txt" "bogus"+    build ["ABn.txt", "--sleep"]+    assertContents "ABn.txt" ""+    writeFile "Bn.txt" "1"+    build ["Bn.txt", "--sleep"]+    build ["ABn.txt"]+    assertContents "ABn.txt" "Bn.txt\n"++    forM_ [[],["--usepredicate"]] $ \args -> do+        writeFile "An.in" "1"+        writeFile "Bn.in" "1"+        removeFile_ "On"+        build $ ["On", "--sleep"] ++ args+        assertContents "On" "An\nBn\nOn\n"+        writeFile "An.in" "1"+        build $ ["On", "--sleep"] ++ args+        assertContents "On" "An\n"+        writeFile "Bn.in" "1"+        build $ ["On", "--sleep"] ++ args+        assertContents "On" "Bn\n"+        build $ ["On", "--sleep"] ++ args+        assertContents "On" "Bn\n"+        removeFile "An"+        build $ ["On", "--sleep"] ++ args+        assertContents "On" "An\n"+        removeFile "An"+        writeFile "Bn.in" "2"+        build $ ["On", "--sleep"] ++ args+        assertContents "On" "An\nBn\n"+        removeFile "On"+        build $ ["On", "--sleep"] ++ args+        assertContents "On" "On\n"++    build ["batch_max." ++ show i | i <- [1..100]]+    assertContents "batch_max.72" "100"++    let names = ["batch_profile." ++ show i | i <- [1..2]]+    build names+    assertTimings build $ ("sleep2",2) : zip names [2,1]
+ src/Test/Benchmark.hs view
@@ -0,0 +1,31 @@++module Test.Benchmark(main) where++import General.GetOpt+import Development.Shake+import Test.Type+import Text.Read+import Data.List.Extra+import Development.Shake.FilePath+++data Opts = Depth Int | Breadth Int+opts = [Option "" ["depth"  ] (ReqArg (fmap Depth   . readEither) "INT") ""+       ,Option "" ["breadth"] (ReqArg (fmap Breadth . readEither) "INT") ""]++-- | Given a breadth and depth come up with a set of build files+main = testBuildArgs test opts $ \opts -> do+    let depth   = lastDef 75 [x | Depth   x <- opts]+    let breadth = lastDef 75 [x | Breadth x <- opts]++    want ["0." ++ show i | i <- [1..breadth]]+    "*" %> \out -> do+        let d = read $ takeBaseName out+        need [show (d + 1) ++ "." ++ show i | d < depth, i <- [1..breadth]]+        writeFile' out ""++test build = do+    -- these help to test the stack limit+    build ["clean"]+    build []+    build []
+ src/Test/Builtin.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving, DeriveDataTypeable #-}++module Test.Builtin(main) where++import Development.Shake+import Development.Shake.Classes+import Development.Shake.Rule+import System.Directory as IO+import qualified System.IO.Extra as IO+import qualified Data.ByteString.Char8 as BS+import Test.Type+++-- WARNING: This code is also reproduced in "Development.Shake.Rule" as documentation.+-- If it needs editing, you probably need to edit it there too.++newtype File = File FilePath+    deriving (Show,Eq,Hashable,Binary,NFData,Typeable)+type instance RuleResult File = ()++data FileRule = FileRule File (Action ())+    deriving Typeable++addBuiltinFileRule :: Rules ()+addBuiltinFileRule = addBuiltinRule noLint noIdentity run+    where+        fileContents (File x) = do b <- IO.doesFileExist x; if b then IO.readFile' x else pure ""++        run :: BuiltinRun File ()+        run key old mode = do+            now <- liftIO $ fileContents key+            if mode == RunDependenciesSame && fmap BS.unpack old == Just now then+                pure $ RunResult ChangedNothing (BS.pack now) ()+            else do+                (_, act) <- getUserRuleOne key (const Nothing) $ \(FileRule k act) -> if k == key then Just act else Nothing+                act+                now <- liftIO $ fileContents key+                pure $ RunResult ChangedRecomputeDiff (BS.pack now) ()++fileRule :: FilePath -> Action () -> Rules ()+fileRule file act = addUserRule $ FileRule (File file) act++fileNeed :: FilePath -> Action ()+fileNeed = apply1 . File+++main = testBuild test $ do+    addBuiltinFileRule++    fileRule "a.txt" $ pure ()+    fileRule "b.txt" $ do+        fileNeed "a.txt"+        liftIO $ appendFile "log.txt" "X"+        liftIO $ writeFile "b.txt" . reverse =<< readFile "a.txt"++    action $ fileNeed "b.txt"+++test build = do+    writeFile "log.txt" ""+    writeFile "a.txt" "test"+    build []+    assertContents "b.txt" "tset"+    assertContents "log.txt" "X"++    build []+    assertContents "log.txt" "X" -- it doesn't rebuild++    writeFile "a.txt" "more"+    build []+    assertContents "b.txt" "erom"
+ src/Test/BuiltinOverride.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TypeFamilies #-}++module Test.BuiltinOverride (main) where++import Control.Concurrent+import Development.Shake+import Development.Shake.Classes+import Development.Shake.Rule+import Test.Type++newtype Key = Key Int+  deriving (Show, Eq, Hashable, Binary, NFData, Typeable)++type instance RuleResult Key = ()++main sleep = do+  store <- newEmptyMVar++  testBuild (test store) (setRules store) sleep++setRules resultsStore = do+  addBuiltinRule noLint noIdentity $ \(Key n) _ _ -> do+    liftIO $ putMVar resultsStore n+    pure $ RunResult ChangedRecomputeDiff mempty ()+  addBuiltinRule noLint noIdentity $ \(Key n) _ _ -> do+    liftIO $ putMVar resultsStore (n + 1)+    pure $ RunResult ChangedRecomputeDiff mempty ()+  action $ apply1 $ Key 1++test store build = do+  build ["--allow-redefine-rules"]++  res <- takeMVar store+  assertBool (res == 2) "Rule was not overridden"++  assertException ["rule defined twice"] $ build ["--quiet"]
+ src/Test/C.hs view
@@ -0,0 +1,28 @@++module Test.C(main) where++import Development.Shake+import Development.Shake.FilePath+import Test.Type++main = testBuild defaultTest $ do+    let src = shakeRoot </> "src/Test/C"+    want ["Main.exe"]++    "Main.exe" %> \out -> do+        cs <- getDirectoryFiles src ["*.c"]+        let os = map (<.> "o") cs+        need os+        cmd "gcc -o" [out] os++    "*.c.o" %> \out -> do+        let c = src </> takeBaseName out+        need [c]+        headers <- cIncludes c+        need $ map ((</>) src . takeFileName) headers+        cmd "gcc -o" [out] "-c" [c]++cIncludes :: FilePath -> Action [FilePath]+cIncludes x = do+    Stdout stdout <- cmd "gcc" ["-MM",x]+    pure $ drop 2 $ words stdout
+ src/Test/C/constants.c view
@@ -0,0 +1,7 @@++char msg[] = "Hello Shake Users!";++char* message()+{+	return msg;+}
+ src/Test/C/constants.h view
@@ -0,0 +1,1 @@+char* message();
+ src/Test/C/main.c view
@@ -0,0 +1,8 @@+#include <stdio.h>+#include "constants.h"++int main()+{+	printf("%s\n", message());+	return 0;+}
+ src/Test/Cache.hs view
@@ -0,0 +1,74 @@++module Test.Cache(main) where++import Development.Shake+import Development.Shake.FilePath+import System.Directory+import Data.Char+import Test.Type+++main = testBuild test $ do+    vowels <- newCache $ \file -> do+        src <- readFile' file+        liftIO $ appendFile "trace.txt" "1"+        pure $ length $ filter isDigit src+    "*.out*" %> \x ->+        writeFile' x . show =<< vowels (dropExtension x <.> "txt")++    startCompiler <- newCache $ \() -> do+        liftIO $ writeFile "compiler.txt" "on"+        runAfter $ writeFile "compiler.txt" "off"++    "*.lang" %> \out -> do+        startCompiler ()+        liftIO $ copyFile "compiler.txt" out++    -- Bug fixed in https://github.com/ndmitchell/shake/pull/796+    bug796_2 <- newCache $ \() -> do+        readFile' "bug796.2"+    "bug796" %> \out -> do+        a <- readFile' "bug796.1"+        b <- bug796_2 ()+        writeFile' out $ a ++ b+++test build = do+    build ["clean"]+    writeFile "trace.txt" ""+    writeFile "vowels.txt" "abc123a"+    build ["vowels.out1","vowels.out2","-j3","--sleep"]+    assertContents "trace.txt" "1"+    assertContents "vowels.out1" "3"+    assertContents "vowels.out2" "3"++    build ["vowels.out2","-j3"]+    assertContents "trace.txt" "1"+    assertContents "vowels.out1" "3"++    writeFile "vowels.txt" "12xyz34"+    build ["vowels.out2","-j3","--sleep"]+    assertContents "trace.txt" "11"+    assertContents "vowels.out2" "4"++    build ["vowels.out1","-j3","--sleep"]+    assertContents "trace.txt" "111"+    assertContents "vowels.out1" "4"++    build ["foo.lang","bar.lang"]+    assertContents "foo.lang" "on"+    assertContents "compiler.txt" "off"+    writeFile "compiler.txt" "unstarted"+    build ["foo.lang","bar.lang"]+    assertContents "compiler.txt" "unstarted"++    writeFile "bug796.1" "a"+    writeFile "bug796.2" "b"+    build ["bug796", "--sleep"]+    assertContents "bug796" "ab"+    writeFile "bug796.1" "A"+    build ["bug796", "--sleep"]+    assertContents "bug796" "Ab"+    writeFile "bug796.2" "B"+    build ["bug796", "--sleep"]+    assertContents "bug796" "AB"
+ src/Test/Cleanup.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable #-}++-- Initially copied from https://raw.githubusercontent.com/snoyberg/conduit/master/resourcet/test/main.hs+-- on 2018-10-11+module Test.Cleanup(main) where++import General.Cleanup+import Data.Typeable+import Control.Monad+import Data.IORef+import Control.Exception+import Test.Type+++main = testSimple $ do+    do -- survives releasing bottom+        x <- newIORef (0 :: Int)+        handle (\(_ :: SomeException) -> pure ()) $ withCleanup $ \cleanup -> do+            _ <- register cleanup $ modifyIORef x (+1)+            release undefined+        (=== 1) =<< readIORef x++    do -- early release+        x <- newIORef (0 :: Int)+        withCleanup $ \cleanup -> do+            undo <- register cleanup $ modifyIORef x (+1)+            release undo+            (=== 1) =<< readIORef x+        (=== 1) =<< readIORef x++    do -- unprotect keeps resource from being cleared+        x <- newIORef (0 :: Int)+        _ <- withCleanup $ \cleanup -> do+            key <- register cleanup $ writeIORef x 1+            unprotect key+        (=== 0) =<< readIORef x+++    do -- cleanup actions are masked https://github.com/snoyberg/conduit/issues/144+        let checkMasked name = do+                ms <- getMaskingState+                unless (ms == MaskedUninterruptible) $+                    error $ show (name, ms)+        withCleanup $ \cleanup -> do+            register cleanup (checkMasked "release") >>= release+            register cleanup (checkMasked "normal")+        Left Dummy <- try $ withCleanup $ \cleanup -> do+            register cleanup (checkMasked "exception")+            throwIO Dummy+        pure ()+++data Dummy = Dummy+    deriving (Show, Typeable)+instance Exception Dummy
+ src/Test/CloseFileHandles.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE CPP #-}+module Test.CloseFileHandles(main) where++import Test.Type++#ifdef mingw32_HOST_OS++main = testNone -- don't know how to do this on windows++#else++import Development.Shake+import Development.Shake.FilePath+import System.Posix.IO+import Control.Monad.Extra+import System.Exit+import System.IO++main = testBuild test $ do+    let helper = toNative $ "helper/close_file_handles_helper" <.> exe+    let name !> test = do want [name]+                          name ~> do need ["helper/close_file_handles_helper" <.> exe]; test++    let helper_source = unlines+            ["import System.Environment"+            ,"import System.Posix.IO"+            ,"import System.IO"+            ,"import System.Exit"+            ,""+            ,"main = do"+            ,"  args <- getArgs"+            ,"  case args of"+            ,"    [fdString] -> do"+            ,"       handle <- fdToHandle (read fdString)"+            ,"       hClose handle"+            ,"       exitSuccess"+            ,"    _ -> do"+            ,"      progName <- getProgName"+            ,"      hPutStrLn stderr (\"usage: \" ++ progName ++ \" <file descriptor number>\\n    tries closing the file descriptor number\\n    exits successful, if the file descriptor was open\")"+            ,"      exitWith (ExitFailure 3)"]++    "close_file_handles_helper.hs" %> \out -> do+        need ["../../src/Test/CloseFileHandles.hs"]+        writeFileChanged out helper_source++    ["helper/close_file_handles_helper"<.>exe, "close_file_handles_helper.hi", "close_file_handles_helper.o"] &%> \_ -> do+        need ["close_file_handles_helper.hs"]+        cmd "ghc --make" "close_file_handles_helper.hs -o helper/close_file_handles_helper"++    let callWithOpenFile cmdWithOpts = withTempFile $+            \file -> actionBracket (openFile file AppendMode) hClose $+                \h -> do fd <- liftIO $ handleToFd h+                         (Exit c, Stdout _, Stderr _) <- cmdWithOpts helper (show fd) :: Action (Exit, Stdout String, Stderr String)+                         pure c++    "defaultbehaviour" !> do+        c <- callWithOpenFile cmd+        liftIO $ assertBool (c == ExitSuccess) "handle closed without option CloseFileHandles"++    "closing" !> do+        c <- callWithOpenFile (cmd CloseFileHandles)+        liftIO $ assertBool (c /= ExitSuccess) "handle not closed with option CloseFileHandles"++test build = do+    whenM hasTracker $+        build ["-j4", "--no-lint"]+    build ["-j4"]++#endif
+ src/Test/Command.hs view
@@ -0,0 +1,194 @@+{-# LANGUAGE Rank2Types, ScopedTypeVariables #-}++module Test.Command(main) where++import Development.Shake+import Development.Shake.FilePath+import Control.Exception.Extra+import System.Time.Extra+import General.Extra+import Control.Monad.Extra+import System.Directory+import Test.Type+import System.Exit+import System.Process+import Data.Tuple.Extra+import Data.List.Extra+import Control.Monad.IO.Class+import System.Info.Extra+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy.Char8 as LBS+++main = testBuild test $ do+    -- shake_helper must be in a subdirectory so we can test placing that subdir on the $PATH+    let helper = toNative $ "helper/shake_helper" <.> exe+    let name !> test = do want [name]+                          name ~> do need ["helper/shake_helper" <.> exe]; test++    let helper_source = unlines+            ["import System.Process"+            ,"import Control.Monad"+            ,"import Control.Concurrent"+            ,"import System.Directory"+            ,"import System.Environment"+            ,"import System.Exit"+            ,"import System.IO"+            ,"import qualified Data.ByteString.Lazy.Char8 as LBS"+            ,"main = do"+            ,"    args <- getArgs"+            ,"    exe <- getExecutablePath"+            ,"    forM_ args $ \\(a:rg) -> do"+            ,"        case a of"+            ,"            'o' -> putStrLn rg"+            ,"            'e' -> hPutStrLn stderr rg"+            ,"            'x' -> exitFailure"+            ,"            'c' -> putStrLn =<< getCurrentDirectory"+            ,"            'v' -> putStrLn =<< getEnv rg"+            ,"            'w' -> threadDelay $ ceiling $ (read rg :: Double) * 1000000"+            ,"            'r' -> LBS.putStr $ LBS.replicate (read rg) 'x'"+            ,"            'i' -> putStr =<< getContents"+            ,"            's' -> void $ readProcess exe [rg] \"\""+            ,"        hFlush stdout"+            ,"        hFlush stderr"+            ]++    "shake_helper.hs" %> \out -> do+        need ["../../src/Test/Command.hs"]+        writeFileChanged out helper_source+    ["helper/shake_helper" <.> exe, "shake_helper.o", "shake_helper.hi"] &%> \_ -> do+        need ["shake_helper.hs"]+        cmd "ghc --make" "shake_helper.hs -o helper/shake_helper"++    "capture" !> do+        (Stderr err, Stdout out) <- cmd helper ["ostuff goes here","eother stuff here"]+        liftIO $ out === "stuff goes here\n"+        liftIO $ err === "other stuff here\n"+        liftIO $ waits $ \w -> do+            Stdouterr out <- cmd helper Shell ["o1",w,"e2",w,"o3"]+            out === "1\n2\n3\n"++    "failure" !> do+        (Exit e, Stdout (), Stderr ()) <- cmd helper "oo ee x"+        when (e == ExitSuccess) $ error "/= ExitSuccess"+        liftIO $ assertException ["BAD"] $ cmd_ helper "oo eBAD x" (EchoStdout False) (EchoStderr False)+        liftIO $ assertException ["MORE"] $ cmd_ helper "oMORE eBAD x" (WithStdout True) (WithStderr False) (EchoStdout False) (EchoStderr False)++    "throws" ~>+        cmd Shell "not_a_process foo"++    "cwd" !> do+        -- FIXME: Linux searches the Cwd argument for the file, Windows searches getCurrentDirectory+        helper <- liftIO $ canonicalizePath $ "helper/shake_helper" <.> exe+        liftIO $ createDirectoryRecursive "helper/tests"+        Stdout out <- cmd (Cwd "helper/tests") (Cwd "..") helper "c"+        let norm = fmap dropTrailingPathSeparator . canonicalizePath . trim+        liftIO $ join $ liftM2 (===) (norm out) (norm "helper")++    let checkTimeout act = do+            offset <- liftIO offsetTime+            act+            t <- liftIO offset+            putInfo $ "Timed out in " ++ showDuration t+            when (t < 2 || t > 8) $ error $ "failed to timeout, took " ++ show t++    "timeout1" !> checkTimeout (do+        Exit exit <- cmd (Timeout 2) helper "w20"+        liftIO $ assertBool (exit /= ExitSuccess) "exit was ExitSuccess")++    "timeout2" !> do checkTimeout $ liftIO $ timeout 2 $ cmd_ helper "w20"++    -- disabled on Windows because when you abort a Shell process you get a+    -- "Do you want to terminate the batch file (Y/N)"+    unless isWindows $ "timeout3" !> do checkTimeout $ liftIO $ timeout 2 $ cmd_ Shell helper "w20"++    "timeout4" !> do checkTimeout $ liftIO $ timeout 2 $ cmd_ helper "sw20"++    "timeout5" !> do checkTimeout $ liftIO $ timeout 2 $ cmd_ helper "i w20"++    "env" !> do+        -- use liftIO since it blows away PATH which makes lint-tracker stop working+        Stdout out <- liftIO $ cmd (Env [("FOO","HELLO SHAKE")]) Shell helper "vFOO"+        liftIO $ out === "HELLO SHAKE\n"+        StdoutTrim out <- cmd (AddEnv "FOO" "GOODBYE SHAKE") Shell helper "vFOO"+        liftIO $ out === "GOODBYE SHAKE"++    "space" !> do+        Stdout out <- cmd helper ["oSPACE 1"]+        liftIO $ out === "SPACE 1\n"+        Stdout out <- cmd Shell helper "\"oSPACE 2\""+        liftIO $ out === "SPACE 2\n"+        whenM (liftIO hasTracker) $ do+            Stdout out <- cmd Shell AutoDeps helper "\"oSPACE 2\""+            liftIO $ out === "SPACE 2\n"+        (Stdout (), CmdLine x) <- cmd helper ["oSPACE 3","oDIRECT"]+        unless (" \"oSPACE 3\" oDIRECT" `isSuffixOf` replace "\'" "\"" x) $+            fail $ "Invalid CmdLine, " ++ x++    "path" !> do+        let path = AddPath [dropTrailingPathSeparator "helper"] []+        cmd_ "helper/shake_helper"+        cmd_ $ "helper/shake_helper" <.> exe+        cmd_ path Shell "shake_helper"+        cmd_ path "shake_helper"++    "file" !> do+        let file = "file.txt"+        cmd_ helper (FileStdout file) (FileStderr file) (EchoStdout False) (EchoStderr False) (WithStderr False) "ofoo ebar obaz"+        liftIO $ assertContents file "foo\nbar\nbaz\n"+        liftIO $ waits $ \w -> do+            Stderr err <- cmd helper (FileStdout file) (FileStderr file) ["ofoo",w,"ebar",w,"obaz"]+            err === "bar\n"+            assertContents file "foo\nbar\nbaz\n"++    "timer" !> do+        timer $ cmd helper++    "binary" !> do+        (Stdout str, Stdout bs) <- cmd BinaryPipes helper "ofoo"+        liftIO $ (===) (str, bs) $ second BS.pack $ dupe $ if isWindows then "foo\r\n" else "foo\n"+        (Stdout str, Stdout bs) <- cmd helper "ofoo"+        liftIO $ (str, bs) === ("foo\n", BS.pack $ if isWindows then "foo\r\n" else "foo\n")+        pure ()++    "large" !> do+        (Stdout (_ :: String), CmdTime t1) <- cmd helper "r10000000"+        (Stdout (_ :: LBS.ByteString), CmdTime t2) <- cmd helper "r10000000"+        t3 <- withTempFile $ \file -> fromCmdTime <$> cmd helper "r10000000" (FileStdout file)+        liftIO $ putStrLn $ "Capturing 10Mb takes: " ++ intercalate ","+            [s ++ " = " ++ showDuration d | (s,d) <- [("String",t1),("ByteString",t2),("File",t3)]]++    "stdin" !> do+        withTempFile $ \file -> do+            liftIO $ writeFile file " "+            Stdout (x :: String) <- cmd helper "i" (Stdin "hello") (FileStdin file) (StdinBS $ LBS.pack "world")+            liftIO $ x === "hello world"++    "async" !> do+        let file = "async.txt"+        pid <- cmd helper (FileStdout file) "w2" "ohello"+        Nothing <- liftIO $ getProcessExitCode pid+        ExitSuccess <- liftIO $ waitForProcess pid+        liftIO $ assertContents file "hello\n"+++test build = do+    -- reduce the overhead by running all the tests in parallel+    -- lint can make a big different to the command lines, so test with and without+    whenM hasTracker $+        build ["-j4","--no-lint"]+    build ["-j4"]++    assertException ["not_a_process foo"] (build ["throws","--quiet"])+++timer :: (CmdResult r, MonadIO m) => (forall r . CmdResult r => m r) -> m r+timer act = do+    (CmdTime t, CmdLine x, r) <- act+    liftIO $ putStrLn $ "Command " ++ x ++ " took " ++ show t ++ " seconds"+    pure r++waits :: (String -> IO ()) -> IO ()+waits op = f 0+    where f w | w > 1 = op "w10"+              | otherwise = catch_ (op $ "w" ++ show w) $ const $ f $ w + 0.1
+ src/Test/Config.hs view
@@ -0,0 +1,58 @@++module Test.Config(main) where++import Development.Shake+import Development.Shake.FilePath+import Development.Shake.Config+import Test.Type+import Data.List.Extra+import qualified Data.HashMap.Strict as Map+import Data.Maybe+++main = testBuild test $ do+    want ["hsflags.var","cflags.var","none.var","keys"]+    usingConfigFile "config"+    "*.var" %> \out -> do+        cfg <- getConfig $ upper $ takeBaseName out+        liftIO $ appendFile (out -<.> "times") "X"+        writeFile' out $ fromMaybe "" cfg+    "keys" %> \out -> do+        liftIO $ appendFile "keys.times" "X"+        liftIO . writeFile out . unwords =<< getConfigKeys+++test build = do+    build ["clean"]+    writeFile "config" $ unlines+        ["HEADERS_DIR = /path/to/dir"+        ,"CFLAGS = -O2 -I${HEADERS_DIR} -g"+        ,"HSFLAGS = -O2"]+    build []+    assertContents "cflags.var" "-O2 -I/path/to/dir -g"+    assertContents "hsflags.var" "-O2"+    assertContents "none.var" ""+    assertContents "keys" "CFLAGS HEADERS_DIR HSFLAGS"++    appendFile "config" $ unlines+        ["CFLAGS = $CFLAGS -w"]+    build []+    assertContents "cflags.var" "-O2 -I/path/to/dir -g -w"+    assertContents "hsflags.var" "-O2"+    assertContents "cflags.times" "XX"+    assertContents "hsflags.times" "X"+    assertContents "keys.times" "X"++    -- Test readConfigFileWithEnv+    writeFile "config" $ unlines+      ["HEADERS_DIR = ${SOURCE_DIR}/path/to/dir"+      ,"CFLAGS = -O2 -I${HEADERS_DIR} -g"]+    vars <- readConfigFileWithEnv [("SOURCE_DIR", "/path/to/src")] "config"+    assertBool (Map.lookup "HEADERS_DIR" vars == Just "/path/to/src/path/to/dir")+        $ "readConfigFileWithEnv:"+            ++ " Expected: " ++ show (Just "/path/to/src/path/to/dir")+            ++ " Got: " ++ show (Map.lookup "HEADERS_DIR" vars)+    assertBool (Map.lookup "CFLAGS" vars == Just "-O2 -I/path/to/src/path/to/dir -g")+        $ "readConfigFileWithEnv:"+            ++ " Expected: " ++ show (Just "-O2 -I/path/to/src/path/to/dir -g")+            ++ " Got: " ++ show (Map.lookup "CFLAGS" vars)
+ src/Test/Database.hs view
@@ -0,0 +1,102 @@++module Test.Database(main) where++import Control.Concurrent.Extra+import Control.Exception.Extra+import Control.Monad+import Data.List+import Data.IORef+import Development.Shake+import Development.Shake.Database+import Development.Shake.FilePath+import System.Time.Extra+import System.Directory as IO+import Test.Type+++rules = do+    "*.out" %> \out -> do+        liftIO $ appendFile "log.txt" "x"+        copyFile' (out -<.> "in") out+        removeFilesAfter "." ["log.txt"]++    "*.err" %> \out -> fail out++    phony "sleep" $ liftIO $ sleep 20++main = testSimple $ do+    let opts = shakeOptions{shakeFiles="/dev/null"}+    writeFile "a.in" "a"+    writeFile "b.in" "b"+    sleepFileTime+    writeFile "log.txt" ""+    (open, close) <- shakeOpenDatabase opts rules+    db <- open++    ([12], after) <- shakeRunDatabase db [need ["a.out"] >> pure 12]+    assertContents "log.txt" "x"++    writeFile "a.in" "A"+    shakeRunDatabase db [need ["a.out","b.out"]]+    assertContents "a.out" "A"+    assertContents "log.txt" "xxx"++    ([13,14], _) <- shakeRunDatabase db [need ["a.out"] >> pure 13, pure 14]+    assertContents "log.txt" "xxx"++    live <- shakeLiveFilesDatabase db+    sort live === ["a.in","a.out"]++    shakeProfileDatabase db "-"++    -- check that parallel runs blow up, and that we can throw async exceptions to kill it+    assertWithin 10 $ do+        threads <- newBarrier+        results <- replicateM 2 newBarrier+        ts <- forM results $ \result -> forkFinally (void $ shakeRunDatabase db [need ["sleep"]]) $ \r -> mask_ $ do+            print $ "Failed with " ++ show r+            signalBarrier result r+            threads <- waitBarrier threads+            me <- myThreadId+            forM_ threads $ \t -> when (t /= me) $ throwTo t $ ErrorCall "ab123c"+        signalBarrier threads ts+        results <- show <$> mapM waitBarrier results+        assertBool ("ab123c" `isInfixOf` results) "Contains ab123c"+        assertBool ("currently running" `isInfixOf` results) "Contains 'currently using'"++    close+    assertException ["already closed"] $ shakeRunDatabase db []++    shakeRunAfter opts after+    assertBoolIO (not <$> IO.doesFileExist "log.txt") "Log must be deleted"++    errs <- shakeWithDatabase opts{shakeStaunch=True, shakeVerbosity=Silent} rules $ \db -> do+        assertException ["Error when running"] $ shakeRunDatabase db [need ["foo.err","bar.err"]]+        shakeErrorsDatabase db+    sort (map fst errs) === ["bar.err","foo.err"]++    -- check the progress thread gets killed properly on normal cleanup+    ref <- newIORef 0+    opts <- pure opts{shakeProgress = const $ bracket_ (modifyIORef ref succ) (modifyIORef ref succ) $ sleep 100}+    (open, close) <- shakeOpenDatabase opts rules+    db <- open+    ([12], after) <- shakeRunDatabase db [need ["a.out"] >> liftIO (modifyIORef ref succ) >> pure 12]+    (=== 3) =<< readIORef ref -- success if it all shuts down cleanly++    -- and on an exception+    writeIORef ref 0+    assertException ["terminate"] $ shakeRunDatabase db [liftIO (modifyIORef ref succ) >> fail "terminate"]+    (=== 3) =<< readIORef ref++    -- and on an external exception+    writeIORef ref 0+    bar <- newBarrier; bar2 <- newBarrier+    t <- flip forkFinally (signalBarrier bar2)  $ void $ shakeRunDatabase db $ pure $ do+        liftIO $ modifyIORef ref succ+        liftIO $ signalBarrier bar ()+        need ["sleep"]+    waitBarrier bar+    sleep 0.1+    killThread t+    waitBarrier bar2+    (=== 3) =<< readIORef ref
+ src/Test/Digest.hs view
@@ -0,0 +1,107 @@++module Test.Digest(main) where++import Control.Monad+import Development.Shake+import Test.Type+++main = testBuild test $ do+    want ["Out.txt","Out2.txt"]++    "Out.txt" %> \out -> do+        txt <- readFile' "In.txt"+        liftIO $ appendFile out txt++    ["Out1.txt","Out2.txt"] &%> \[out1,out2] -> do+        txt <- readFile' "In.txt"+        liftIO $ appendFile out1 txt+        liftIO $ appendFile out2 txt++    ["Bug1.txt","Bug2.txt"] &%> \[out1,out2] -> do+        need ["Bug3.txt"]+        writeFile' out1 "X"+        writeFile' out2 "Y"++    "leaf" ~> pure ()+    "node1.txt" %> \file -> do need ["leaf"]; writeFile' file "x"+    "node2.txt" %> \file -> do need ["node1.txt"]; liftIO $ appendFile file "x"++    ["rewrite1","rewrite2"] &%> \outs -> do+        alwaysRerun+        forM_ outs $ \out -> writeFile' out "rewrite"+++test build = do+    let outs = ["Out.txt","Out1.txt","Out2.txt"]+    let writeOut x = forM_ outs $ \out -> writeFile out x+    let writeIn = writeFile "In.txt"+    let assertOut x = forM_ outs $ \out -> assertContents out x++    writeOut ""+    writeIn "X"+    build ["--sleep","--digest-and"]+    assertOut "X"++    -- should not involve a hash calculation (sadly no way to test that)+    build ["--sleep","--digest-and"]+    assertOut "X"++    writeIn "X"+    build ["--sleep","--digest-and"]+    assertOut "X"++    writeIn "X"+    build ["--sleep","--digest-or"]+    assertOut "XX"++    writeIn "X"+    build ["--sleep","--digest-and"]+    assertOut "XX"++    build ["--sleep","--digest-and"]+    writeOut "XX"+    build ["--sleep","--digest-and"]+    assertOut "XX"++    build ["--sleep","--digest-and"]+    writeOut "Y"+    build ["--sleep","--digest-and"]+    assertOut "YX"++    writeIn "X"+    build ["--sleep","--digest"]+    assertOut "YX"++    writeIn "Z"+    build ["--sleep","--digest-and-input"]+    assertOut "YXZ"++    build ["--sleep","--digest-and-input"]+    writeOut "YXZ"+    build ["--sleep","--digest-and-input"]+    assertOut "YXZZ"++    writeIn "Q"+    build ["--sleep","--digest-and-input"]+    assertOut "YXZZQ"++    writeIn "Q"+    build ["--sleep","--digest-and-input"]+    assertOut "YXZZQ"++    -- test for #218+    forM_ [("--digest",1),("--digest-and",1),("--digest-or",2),("--digest-and-input",2),("",2)] $ \(flag,count) -> do+        writeFile "node2.txt" "y"+        replicateM_ 2 $ build $ ["node2.txt","--sleep"] ++ [flag | flag /= ""]+        assertContents "node2.txt" $ 'y' : replicate count 'x'++    -- test for #296+    writeFile "Bug3.txt" "X"+    build ["--digest-and-input","Bug1.txt","--sleep"]+    writeFile "Bug3.txt" "Y"+    build ["--digest-and-input","Bug1.txt","--lint"]++    -- test for #427+    build ["rewrite1","--digest-and"]+    build ["rewrite1","--digest-and","--lint","--sleep"]
+ src/Test/Directory.hs view
@@ -0,0 +1,115 @@+{-# LANGUAGE TupleSections #-}++module Test.Directory(main) where++import Development.Shake+import Development.Shake.FilePath+import Test.Type+import Data.List+import Data.Function+import Control.Monad+import General.Extra+import System.Directory(createDirectory)+import qualified System.Directory as IO+import qualified System.IO.Extra as IO+++-- Use escape characters, _o=* _l=/ __=<space>+readEsc ('_':'o':xs) = '*' : readEsc xs+readEsc ('_':'l':xs) = '/' : readEsc xs+readEsc ('_':'_':xs) = ' ' : readEsc xs+readEsc (x:xs) = x : readEsc xs+readEsc [] = []++showEsc = concatMap f+    where f '*' = "_o"+          f '/' = "_l"+          f ' ' = "__"+          f x = [x]+++main = testBuild test $ do+    "*.contents" %> \out ->+        writeFileLines out =<< getDirectoryContents (readEsc $ dropExtension out)+    "*.dirs" %> \out ->+        writeFileLines out =<< getDirectoryDirs (readEsc $ dropExtension out)+    "*.files" %> \out -> do+        let pats = readEsc $ dropExtension out+        let (x:xs) = ["" | " " `isPrefixOf` pats] ++ words pats+        writeFileLines out . map toStandard =<< getDirectoryFiles x xs++    "*.exist" %> \out -> do+        let xs = words $ readEsc $ dropExtension out+        fs <- mapM doesFileExist xs+        ds <- mapM doesDirectoryExist xs+        let bool x = if x then "1" else "0"+        writeFileLines out $ zipWith ((++) `on` bool) fs ds++    "dots" %> \out -> do+        b1 <- liftM2 (==) (getDirectoryContents ".") (getDirectoryContents "")+        b2 <- liftM2 (==) (getDirectoryDirs ".") (getDirectoryDirs "")+        b3 <- liftM2 (==) (getDirectoryFiles "." ["*.txt"]) (getDirectoryFiles "" ["*.txt"])+        b4 <- liftM2 (==) (getDirectoryFiles "." ["C.txt/*.txt"]) (getDirectoryFiles "" ["C.txt/*.txt"])+        b5 <- liftM2 (==) (getDirectoryFiles "." ["//*.txt"]) (getDirectoryFiles "" ["//*.txt"])+        writeFileLines out $ map show [b1,b2,b3,b4,b5]++test build = do+    let demand x ys = let f = showEsc x in do build [f]; assertContents f $ unlines $ words ys+    build ["clean"]+    demand " *.txt.files" ""+    demand " //*.txt.files" ""+    demand ".dirs" ""+    demand "A.txt B.txt C.txt.exist" "00 00 00"++    writeFile "A.txt" ""+    writeFile "B.txt" ""+    createDirectory "C.txt"+    writeFile "C.txt/D.txt" ""+    writeFile "C.txt/E.xtx" ""+    demand " *.txt.files" "A.txt B.txt"+    demand ".dirs" "C.txt"+    demand "A.txt B.txt C.txt.exist" "10 10 01"+    demand " //*.txt.files" "A.txt B.txt C.txt/D.txt"+    demand "C.txt *.txt.files" "D.txt"+    demand " *.txt //*.xtx.files" "A.txt B.txt C.txt/E.xtx"+    demand " C.txt/*.files" "C.txt/D.txt C.txt/E.xtx"++    demand " missing_dir/*.files" ""+    demand " missing_dir/bar/*.files" ""+    demand " //missing_dir/*.files" ""+    assertException ["missing_dir","does not exist"] $ build ["--quiet",showEsc "missing_dir *.files"]++    build ["dots","--no-lint"]+    assertContents "dots" $ unlines $ words "True True True True True"++    let removeTest pat del keep =+            IO.withTempDir $ \dir -> do+                forM_ (del ++ keep) $ \s -> do+                    createDirectoryRecursive $ dir </> takeDirectory s+                    unless (hasTrailingPathSeparator s) $+                        writeFile (dir </> s) ""+                removeFiles dir pat+                createDirectoryRecursive dir+                forM_ (map (False,) del ++ map (True,) keep) $ \(b,s) -> do+                    b2 <- (if hasTrailingPathSeparator s then IO.doesDirectoryExist else IO.doesFileExist) $ dir </> s+                    when (b /= b2) $ do+                        let f b = if b then "present" else "missing"+                        error $ "removeFiles mismatch: with pattern " ++ show pat ++ ", " ++ s +++                                " should be " ++ f b ++ " but is " ++ f b2++    removeTest ["//bob"] ["test/bob","more/bob"] ["extra/obo"]+    removeTest ["bob"] ["bob/"] ["bar/"]+    removeTest ["*.hs"] ["test.hs"] ["extra/more.hs","new.txt"]+    removeTest ["baz"] ["baz"] ["foo","bar/bob"]+    removeTest ["baz"] ["baz/bob","baz/"] ["foo","bar/bob"]+    removeTest ["Foo//*"] ["Foo/bar","Foo/Quux/bar","Foo/Quux/"] []+    removeTest ["Foo//"] ["Foo/"] ["bar"]+    removeTest ["baz"] [] ["test.hs","bar/","foo/"]+    removeTest ["bob//*"] [] ["test/bob/"]+    removeTest ["//bob"] ["test/bob/"] ["test/"]+    removeTest ["//*.txt"] ["more/a.txt"] ["more/"]+    removeTest ["//*.txt"] ["more/a.txt/"] ["more/"]+    removeTest ["//*.txt"] ["more/a.txt/","more/b.txt"] ["more/"]+    removeTest ["//*.txt"] [] ["more/"]+    removeTest ["a//b"] ["a/c/b"] []+    removeFiles "non-existing-directory" ["*"]
+ src/Test/Docs.hs view
@@ -0,0 +1,400 @@+{-# LANGUAGE PatternGuards, ViewPatterns #-}++module Test.Docs(main) where++import Development.Shake+import Development.Shake.FilePath+import qualified System.FilePattern.Directory as IO+import System.Directory+import Test.Type+import Data.Char+import Data.List.Extra+++-- Can't get the paths to work on CI with tracking etc+main = testBuild (notCI . defaultTest) $ do+    let index = "dist/doc/html/shake/index.html"+    let setup = "dist/setup.exe"+    let config = "dist/setup-config"+    want ["Success.txt"]+    let trackIgnore = trackAllow ["dist/**", "dist-newstyle/**"]++    let needSource = need =<< getDirectoryFiles "." (map (shakeRoot </>)+            ["src/Development/Shake.hs","src/Development/Shake//*.hs","src/Development/Ninja/*.hs","src/General//*.hs"])++    let runSetup :: [String] -> Action ()+        runSetup args = do+            trackIgnore+            need [setup]+            -- Make Cabal and Stack play nicely with GHC_PACKAGE_PATH+            setup <- liftIO $ canonicalizePath setup+            cmd_ (RemEnv "GHC_PACKAGE_PATH") (Cwd shakeRoot) setup args++    setup %> \_ -> do+        -- Important to compile the setup binary, or we run foul of+        -- https://gitlab.haskell.org/ghc/ghc/issues/17575+        trackIgnore+        need [shakeRoot </> "Setup.hs"]+        setup <- liftIO $ canonicalizePath setup+        curdir <- liftIO $ canonicalizePath "dist"+        cmd_ (Cwd shakeRoot) "ghc -package=Cabal Setup.hs -o" [setup] "-outputdir" [curdir]++    config %> \_ -> do+        path <- getEnv "GHC_PACKAGE_PATH"+        dist <- liftIO $ canonicalizePath "dist" -- make sure it works even if we cwd+        need [shakeRoot </> "shake.cabal"]+        runSetup $+            ["configure","--builddir=" ++ dist,"--user"] +++            -- package-db is very sensitive, see #267+            -- note that the reverse ensures the behaviour is consistent between the flags and the env variable+            ["--package-db=" ++ x | x <- maybe [] (reverse . filter (`notElem` [".",""]) . splitSearchPath) path]++        -- Paths_shake is only created by "Setup build" (which we want to skip), and required by "Setup haddock", so we fake it+        copyFile' (shakeRoot </> "src/Paths.hs") "dist/build/autogen/Paths_shake.hs"+        copyFile' (shakeRoot </> "src/Paths.hs") "dist/build/shake/autogen/Paths_shake.hs"+        writeFile' "dist/build/autogen/cabal_macros.h" ""+        writeFile' "dist/build/shake/autogen/cabal_macros.h" ""++    index %> \_ -> do+        need $ config : map (shakeRoot </>) ["shake.cabal","Setup.hs","README.md","CHANGES.txt","docs/Manual.md","docs/shake-progress.png"]+        needSource+        trackIgnore+        dist <- liftIO $ canonicalizePath "dist"+        runSetup ["haddock", "--builddir=" ++ dist]++    "Part_*.hs" %> \out -> do+        need [shakeRoot </> "src/Test/Docs.hs"] -- so much of the generator is in this module+        let noR = filter (/= '\r')+        src <- if "_md" `isSuffixOf` takeBaseName out then+            fmap (findCodeMarkdown . lines . checkBlacklist . noR) $ readFile' $ shakeRoot </> "docs/" ++ drop 5 (reverse (drop 3 $ reverse $ takeBaseName out)) ++ ".md"+         else+            fmap (findCodeHaddock . checkBlacklist . noR) $ readFile' $ "dist/doc/html/shake/" ++ replace "_" "-" (drop 5 $ takeBaseName out) ++ ".html"++        let (imports,rest) = partition ("import " `isPrefixOf`) $ showCode src+        writeFileChanged out $ unlines $+            ["{-# LANGUAGE DeriveDataTypeable, RankNTypes, ExtendedDefaultRules, GeneralizedNewtypeDeriving #-}"+            ,"{-# LANGUAGE NoMonomorphismRestriction, ScopedTypeVariables, ConstraintKinds, FlexibleContexts, TypeFamilies #-}"+            ,"{-# OPTIONS_GHC -w #-}"+            ,"module " ++ takeBaseName out ++ "() where"+            ,"import Control.Applicative"+            ,"import Control.Concurrent"+            ,"import Control.Exception"+            ,"import Control.Monad"+            ,"import Control.Monad.Trans.Reader"+            ,"import Data.ByteString(ByteString, pack, unpack)"+            ,"import qualified Data.ByteString.Char8 as BS"+            ,"import qualified System.Directory.Extra as IO"+            ,"import qualified System.IO.Extra as IO"+            ,"import Data.Char"+            ,"import Data.Data"+            ,"import Data.Dynamic"+            ,"import Data.List.Extra"+            ,"import System.Time.Extra"+            ,"import Data.Maybe"+            ,"import Data.Monoid"+            ,"import Development.Shake hiding ((*>))"+            ,"import Development.Shake.Command"+            ,"import Development.Shake.Classes"+            ,"import Development.Shake.Database"+            ,"import Development.Shake.Rule"+            ,"import Development.Shake.Util"+            ,"import Development.Shake.FilePath"+            ,"import System.Console.GetOpt"+            ,"import System.Directory(setCurrentDirectory, withCurrentDirectory)"+            ,"import qualified System.Directory"+            ,"import System.Environment(withArgs, lookupEnv, getEnvironment)"+            ,"import System.Process"+            ,"import System.Exit"+            ,"import Control.Applicative"+            ,"import Control.Monad.IO.Class"+            ,"import Control.Monad.Fail"+            ,"import System.IO hiding (readFile')"] +++            ["import " ++ replace "_" "." (drop 5 $ takeBaseName out) | not $ "_md.hs" `isSuffixOf` out] +++            imports +++            ["(==>) :: Bool -> Bool -> Bool"+            ,"(==>) = undefined"+            ,"(<==) = ()"+            ,"infix 1 ==>"+            ,"infix 0 ==="+            ,"(===) :: a -> a -> b"+            ,"(===) = undefined"+            ,"forAll f = f undefined"+            ,"remaining = 1.1"+            ,"done = 1.1"+            ,"time_elapsed = 1.1"+            ,"old = \"\""+            ,"new = \"\""+            ,"myvar = \"\""+            ,"myfile = \"\""+            ,"inputs = [\"\"]"+            ,"files = [\"\"]"+            ,"input = \"\""+            ,"output = \"\""+            ,"opts = shakeOptions"+            ,"result = undefined :: IO (Maybe (Rules ()))"+            ,"launchMissiles = undefined :: Bool -> IO ()"+            ,"myVariable = ()"+            ,"instance Eq (OptDescr a)"+            ,"(foo,bar,baz) = undefined"+            ,"(p1,p2) = (0.0, 0.0)"+            ,"(r1,r2) = (pure () :: Rules(), pure () :: Rules())"+            ,"xs = []"+            ,"ys = []"+            ,"os = [\"file.o\"]"+            ,"out = \"\""+            ,"str1 = \"\""+            ,"str2 = \"\""+            ,"def = undefined"+            ,"var = undefined"+            ,"newValue = undefined"+            ,"newStore = BS.empty"+            ,"change = ChangedNothing"+            ,"str = \"\""] +++            rest++    "Files.lst" %> \out -> do+        need [shakeRoot </> "src/Test/Docs.hs"] -- so much of the generator is in this module+        need [index]+        filesHs <- liftIO $ IO.getDirectoryFiles "dist/doc/html/shake" ["Development-*.html"]+        -- filesMd on Travis will only include Manual.md, since it's the only one listed in the .cabal+        -- On AppVeyor, where we build from source, it will check the rest of the website+        filesMd <- getDirectoryFiles (shakeRoot </> "docs") ["*.md"]+        writeFileChanged out $ unlines $+            ["Part_" ++ replace "-" "_" (takeBaseName x) | x <- filesHs,+                not $ any (`isSuffixOf` x) ["-Classes.html", "-FilePath.html"]] +++            ["Part_" ++ takeBaseName x ++ "_md" | x <- filesMd,+                takeBaseName x `notElem` ["Developing","Model","Architecture"]]++    let needModules = do mods <- readFileLines "Files.lst"; need [m <.> "hs" | m <- mods]; pure mods++    "Main.hs" %> \out -> do+        mods <- needModules+        writeFileLines out $ ["module Main(main) where"] ++ ["import " ++ m ++ "()" | m <- mods] ++ ["main = pure ()"]++    "Success.txt" %> \out -> do+        putInfo . ("Checking documentation for:\n" ++) =<< readFile' "Files.lst"+        needModules+        need ["Main.hs"]+        trackIgnore+        needSource+        cmd_ "ghc -fno-code -ignore-package=hashmap" ["-idist/build/autogen","-i" ++ shakeRoot </> "src","Main.hs"]+        writeFile' out ""++checkBlacklist :: String -> String+checkBlacklist xs = if null bad then xs else error $ show ("Blacklist", bad)+    where bad = [(w, x) | x <- map lower $ lines xs, w <- blacklist, w `isInfixOf` x]++---------------------------------------------------------------------+-- FIND THE CODE++newtype Code = Code [String] deriving (Show,Eq,Ord)+++findCodeHaddock :: String -> [Code]+findCodeHaddock src =+    [ Code $ unindent $ lines $ innerText x+    | tag <- ["code","pre"]+    , x <- insideTag tag src+    , let bad = nubOrd (insideTag "em" x) \\ italics+    , if null bad then True else error $ "Bad italics, " ++ show bad+    ]+++findCodeMarkdown :: [String] -> [Code]+findCodeMarkdown (x:xs) | indented x && not (isBlank x) =+    let (a,b) = span (\x -> indented x || isBlank x) (x:xs)+    in Code (dropWhileEnd isBlank $ unindent a) : findCodeMarkdown b+    where+        indented x = length (takeWhile isSpace x) >= 4+findCodeMarkdown (x:xs) = map (Code . pure) (evens $ splitOn "`" x) ++ findCodeMarkdown xs+    where+        evens (_:x:xs) = x : evens xs+        evens _ = []+findCodeMarkdown [] = []+++---------------------------------------------------------------------+-- RENDER THE CODE++showCode :: [Code] -> [String]+showCode = concat . zipWithFrom f 1 . nubOrd+    where+        f i (Code x) | "#" `isPrefixOf` concat x = []+                     | all whitelist x = []+                     | otherwise = showStmt i $ filter (not . isBlank . dropComment) $ fixCmd $ map undefDots x+++fixCmd :: [String] -> [String]+fixCmd xs+    | all ("cmd_ " `isPrefixOf`) xs = xs ++ ["pure () :: IO () "]+    | otherwise = map (replace "Stdout out" "Stdout (out :: String)" . replace "Stderr err" "Stderr (err :: String)") xs++-- | Replace ... with undefined (don't use undefined with cmd; two ...'s should become one replacement)+undefDots :: String -> String+undefDots x | Just x <- stripSuffix "..." x, Just (x,_) <- stripInfix "..." x = x ++ new+            | otherwise = replace "..." new x+    where new = if words x `disjoint` ["cmd","cmd_","Development.Shake.cmd","Development.Shake.cmd_"] then "undefined" else "[\"\"]"++showStmt :: Int -> [String] -> [String]+showStmt _ [] = []+showStmt i xs | isDecl $ unlines xs = map f xs+    where f x = if fst (word1 x) `elem` dupes then "_" ++ show i ++ "_" ++ x else x+showStmt i [x] | filter isAlpha (fst $ word1 x) `elem` types = ["type Code_" ++ show i ++ " = " ++ x]+showStmt i [x] | length (words x) <= 2 = ["code_" ++ show i ++ " = (" ++ x ++ ")"] -- deal with operators and sections+showStmt i xs | all isPredicate xs, length xs > 1 =+    zipWithFrom (\j x -> "code_" ++ show i ++ "_" ++ show j ++ " = " ++ x) 1 xs+showStmt i xs = ("code_" ++ show i ++ " = do") : map ("  " ++) xs ++ ["  undefined" | isBindStmt $ last xs]++isPredicate :: String -> Bool+isPredicate x = not $ disjoint (words x) ["==","?=="]++isBindStmt :: String -> Bool+isBindStmt x = "let " `isPrefixOf` x || " <- " `isInfixOf` x++isDecl :: String -> Bool+isDecl x | fst (word1 x) `elem` ["import","infix","instance","newtype","data"] = True+isDecl (words -> name:"::":_) | all isAlphaNum name = True -- foo :: Type Signature+isDecl x | "=" `elem` takeWhile (`notElem` ["let","where"]) (words $ takeWhile (/= '{') x) = True -- foo arg1 arg2 = an implementation+isDecl _ = False+++---------------------------------------------------------------------+-- TEXT MANIPULATION++-- | Is a string empty or whitespace+isBlank :: String -> Bool+isBlank = all isSpace++-- | If all lines are indented by at least n spaces, then trim n spaces from each line+unindent :: [String] -> [String]+unindent xs = map (drop n) xs+    where n = minimum $ 1000 : map (length . takeWhile (== ' ')) (filter (not . isBlank) xs)++-- | Remove line comments from the end of lines+dropComment :: String -> String+dropComment = fst . breakOn "--"++-- | Find all pieces of text inside a given tag+insideTag :: String -> String -> [String]+insideTag tag = map (fst . breakOn ("</" ++ tag ++ ">")) . drop1 . splitOn ("<" ++ tag ++ ">")++-- | Given some HTML, find the raw text+innerText :: String -> String+innerText ('<':xs) = innerText $ drop1 $ dropWhile (/= '>') xs+innerText ('&':xs)+    | Just xs <- stripPrefix "quot;" xs = '\"' : innerText xs+    | Just xs <- stripPrefix "lt;" xs = '<' : innerText xs+    | Just xs <- stripPrefix "gt;" xs = '>' : innerText xs+    | Just xs <- stripPrefix "amp;" xs = '&' : innerText xs+innerText (x:xs) = x : innerText xs+innerText [] = []+++---------------------------------------------------------------------+-- DATA SECTION++-- | Only the following identifiers can appear in italic code blocks in Haddock+--   (otherwise it's a common markup mistake)+italics :: [String]+italics = words "command-name file-name N"++-- | Identifiers that indicate the fragment is a type+types :: [String]+types = words $+    "MVar IO String FilePath Maybe [String] FSATrace Char ExitCode ReaderT Change " +++    "Action Resource Rebuild FilePattern Development.Shake.FilePattern " +++    "Lint Verbosity Rules CmdOption Int Double " +++    "NFData Binary Hashable Eq Typeable Show Applicative " +++    "CmdResult ByteString ProcessHandle Rule Monad MonadFail Monoid Data TypeRep " +++    "BuiltinRun BuiltinLint BuiltinCheck ShakeDatabase"++-- | Duplicated identifiers which require renaming+dupes :: [String]+dupes = words "main progressSimple rules"+++isFilePath :: String -> Bool+isFilePath x = "C:\\" `isPrefixOf` x || (all validChar  x && ("foo/" `isPrefixOf` x || takeExtension x `elem` exts))+    where+        validChar x = isAlphaNum x || x `elem` "_./*"+        exts = words $ ".txt .hi .hs .o .exe .tar .cpp .cfg .dep .out .deps .m .h .c .html .zip " +++                       ".js .json .trace .database .src .sh .bat .ninja .rot13 .version .digits .prof .md"++isCmdFlag :: String -> Bool+isCmdFlag "+RTS" = True+isCmdFlag x = length a `elem` [1,2] && all (\x -> isAlphaNum x || x `elem` "-=/_[]") b+    where (a,b) = span (== '-') x++isCmdFlags :: String -> Bool+isCmdFlags = all (\x -> let y = dropSuffix "," x in isCmdFlag y || isArg y) . words+    where isArg = all (\x -> isUpper x || x == '=')++isEnvVar :: String -> Bool+isEnvVar x | Just x <- stripPrefix "$" x = all validChar x+           | Just x <- stripPrefix "%" x, Just x <- stripSuffix "%" x = all validChar x+           | otherwise = False+    where validChar x = isAlpha x || x == '_'++isProgram :: String -> Bool+isProgram (words -> x:xs) = x `elem` programs && all (\x -> isCmdFlag x || isFilePath x || all isAlpha x || x == "&&") xs+    where programs = words "excel gcc docker cl make ghc ghci cabal distcc npm build tar git fsatrace ninja touch pwd runhaskell rot13 main shake stack rm cat sed sh apt-get build-multiple"+isProgram _ = False++-- | Should a fragment be whitelisted and not checked+whitelist :: String -> Bool+whitelist x | null x || isFilePath x || isCmdFlags x || isEnvVar x || isProgram x = True+whitelist x | elem x $ words $+    "newtype do a q m c x value key os contents clean _make " +++    ".. /. // \\ //* dir/*/* dir [ " +++    "ConstraintKinds TemplateHaskell ApplicativeDo OverloadedLists OverloadedStrings GeneralizedNewtypeDeriving DeriveDataTypeable TypeFamilies SetConsoleTitle " +++    "Data.List System.Directory Development.Shake.FilePath run " +++    "NoProgress Error src about://tracing " +++    ".make/i586-linux-gcc/output build " +++    "/usr/special /usr/special/userbinary " +++    "Hidden extension xterm main opts result flagValues argValues fail " +++    "HEADERS_DIR /path/to/dir CFLAGS let linkFlags temp code out err " +++    "_shake _shake/build manual chrome://tracing/ compdb " +++    "docs/manual foo.* _build _build/run depfile 0.000s " +++    "@ndm_haskell file-name .PHONY filepath trim base stack extra #include " +++    "*> BuiltinRun BuiltinLint BuiltinIdentity RuleResult " +++    "oldStore mode node_modules llbuild Makefile " +++    "RebuildNever RLIMIT_NOFILE "+    = True+whitelist x = x `elem`+    ["[Foo.hi, Foo.o]"+    ,"shake-progress"+    ,"type instance"+    ,"1m25s (15%)"+    ,"3m12s (82%)"+    ,"getPkgVersion $ GhcPkgVersion \"shake\""+    ,"ghc --make MyBuildSystem -threaded -rtsopts \"-with-rtsopts=-I0 -qg\""+    ,"# command-name (for file-name)"+    ,"<i>build rules</i>"+    ,"<i>actions</i>"+    ,"shakeFiles=\"_build\""+    ,"#include \""+    ,"pattern %> actions = (pattern ?==) ?> actions" -- because it overlaps+    ,"buildDir = \"_build\""+    ,"#!/bin/sh"+    ,"shake-build-system"+    ,"\"_build\" </> x -<.> \"o\""+    ,"[item1,item2,item2]"+    ,"$(LitE . StringL . loc_filename <$> location)"+    ,"-d[ FILE], --debug[=FILE]"+    ,"-r[ FILE], --report[=FILE], --profile[=FILE]"+    ,"man 2 getrlimit"+    ]++blacklist :: [String]+blacklist =+    -- from https://twitter.com/jesstelford/status/992756386160234497+    ["obviously"+    ,"basically"+    ,"simply"+    ,"of course"+    ,"clearly"+    ,"everyone knows"+    -- ,"however"+    -- ,"so,"+    -- ,"easy"+    ]
+ src/Test/Errors.hs view
@@ -0,0 +1,296 @@+{-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving, DeriveDataTypeable, ScopedTypeVariables #-}++module Test.Errors(main) where++import Development.Shake+import Development.Shake.Classes+import Development.Shake.FilePath+import Test.Type+import Data.List.Extra+import Control.Monad+import Control.Concurrent.Extra+import General.GetOpt+import General.Extra+import Data.IORef+import Control.Exception.Extra+import System.Directory as IO+import System.Time.Extra+import qualified System.IO.Extra as IO+++data Args = Die deriving (Eq,Enum,Bounded,Show)++newtype BadBinary = BadBinary String deriving (NFData,Show,Eq,Hashable,Typeable)+type instance RuleResult BadBinary = BadBinary+instance Binary BadBinary where+    put (BadBinary x) = put x+    get = do x <- get; if x == "bad" then error "get: BadBinary \"bad\"" else pure $ BadBinary x++main = testBuildArgs test optionsEnum $ \args -> do+    "norule" %> \_ ->+        need ["norule_isavailable"]++    "failcreate" %> \_ ->+        pure ()++    ["failcreates", "failcreates2"] &%> \_ ->+        writeFile' "failcreates" ""++    "recursive_" %> \_ -> need ["intermediate_"]+    "intermediate_" %> \_ -> need ["recursive_"]++    "rec1" %> \_ -> need ["rec2"]+    "rec2" %> \_ -> need ["rec1"]++    "systemcmd" %> \_ ->+        cmd "random_missing_command"++    "stack1" %> \_ -> need ["stack2"]+    "stack2" %> \_ -> need ["stack3"]+    "stack3" %> \_ -> error "crash"++    "staunch1" %> \out -> do+        liftIO $ sleep 0.1+        writeFile' out "test"+    "staunch2" %> \_ -> error "crash"++    let catcher out op = out %> \out -> do+            writeFile' out "0"+            op $ do src <- IO.readFile' out; writeFile out $ show (read src + 1 :: Int)+    catcher "finally1" $ actionFinally $ fail "die"+    catcher "finally2" $ actionFinally $ pure ()+    catcher "finally3" $ actionFinally $ liftIO $ sleep 10+    catcher "finally4" $ actionFinally $ need ["wait"]+    "wait" ~> do liftIO $ sleep 10+    catcher "exception1" $ actionOnException $ fail "die"+    catcher "exception2" $ actionOnException $ pure ()++    "retry*" %> \out -> do+        ref <- liftIO $ newIORef 3+        actionRetry (read [last out]) $ liftIO $ do+            old <- readIORef ref+            writeIORef ref $ old - 1+            if old == 0 then writeFile' out "" else fail "die"++    res <- newResource "resource_name" 1+    "resource" %> \_ ->+        withResource res 1 $+            need ["resource-dep"]++    "overlap.txt" %> \out -> writeFile' out "overlap.txt"+    "overlap.t*" %> \out -> writeFile' out "overlap.t*"+    "overlap.*" %> \out -> writeFile' out "overlap.*"+    ["*.txx","*.tox"] &%> \_ -> fail "do not run"+    ["*p.txx"] &%> \_ -> fail "do not run"++    "chain.2" %> \out -> do+        src <- readFile' "chain.1"+        if src == "err" then error "err_chain" else writeFileChanged out src+    "chain.3" %> \out -> copyFile' "chain.2" out++    "tempfile" %> \out -> do+        file <- withTempFile $ \file -> do+            liftIO $ assertExists file+            pure file+        liftIO $ assertMissing file+        withTempFile $ \file -> do+            liftIO $ assertExists file+            writeFile' out file+            fail "tempfile-died"++    "tempdir" %> \out -> do+        file <- withTempDir $ \dir -> do+            let file = dir </> "foo.txt"+            liftIO $ writeFile (dir </> "foo.txt") ""+                -- will throw if the directory does not exist+            writeFile' out ""+            pure file+        liftIO $ assertMissing file++    phony "fail1" $ fail "die1"+    phony "fail2" $ fail "die2"++    when (Die `elem` args) $ action $ error "death error"++    "fresh_dir" %> \out -> liftIO $ createDirectoryRecursive out+    "need_dir" %> \out -> do+        liftIO $ createDirectoryRecursive "existing_dir"+        need ["existing_dir"]+        writeFile' out ""++    "persist_failure.1" %> \out -> do+        liftIO $ appendFile "persist_failure.log" "[pre]"+        need ["persist_failure.2"]+        liftIO $ appendFile "persist_failure.log" "[post]"+        writeFile' out ""+    "persist_failure.2" %> \out -> do+        src <- readFile' "persist_failure.3"+        liftIO $ print ("persist_failure.3", src)+        if src == "die" then do+            liftIO $ appendFile "persist_failure.log" "[err]"+            fail "die"+        else+            writeFileChanged out src++    "fast_failure" %> \_ -> do+        liftIO $ sleep 0.1+        fail "die"+    "slow_success" %> \out -> do+        liftIO $ sleep 20+        writeFile' out ""++    addOracle $ \(BadBinary x) -> pure $ BadBinary $ 'b':x+    "badinput" %> \out -> do+        askOracle $ BadBinary "bad"+        liftIO $ appendFile out "x"+    "badoutput" %> \out -> do+        askOracle $ BadBinary "ad"+        liftIO $ appendFile out "x"+    "badnone" %> \out -> do+        alwaysRerun+        liftIO $ appendFile out "x"++    "produces1" %> \out -> do+        produces [out <.> "also"]+        writeFile' (out <.> "also") ""+        writeFile' out ""+    "produces2" %> \out -> do+        produces [out <.> "also"]+        writeFile' out ""++    "finalfinal" %> \out -> do+        writeFile' out ""+        lock <- liftIO newLock+        let output = withLock lock . appendFile out+        liftIO (sleep 100)+            `actionFinally` (output "X" >> sleep 0.1)+            `actionFinally` output "Y"++    let catching out = flip actionCatch $ \(e :: SomeException) -> writeFile' out $ show e+    "catch1" %> \out -> catching out $ fail "magic1"+    "catch2" %> \out -> catching out $ liftIO $ killThread =<< myThreadId+    "catch3.1" %> \out -> fail "magic3"+    "catch3.2" %> \out -> catching out $ need ["catch3.1"]++    -- not tested by default since only causes an error when idle GC is turned on+    phony "block" $+        liftIO $ putStrLn $ let x = x in x++test build = do+    -- on Windows, file paths may end up with \ separators, make sure we can still match them+    let crash args parts = assertExceptionAfter (replace "\\" "/") parts (build $ "--quiet" : args)+    build ["clean"]++    writeFile "chain.1" "x"+    build ["chain.3","--sleep"]+    writeFile "chain.1" "err"+    crash ["chain.3"] ["err_chain"]++    crash ["norule"] ["norule_isavailable"]+    crash ["failcreate"] ["failcreate"]+    crash ["failcreates"] ["failcreates"]+    crash ["recursive_"] ["recursive_","intermediate_","recursive"]+    crash ["rec1","rec2"] ["rec1","rec2","indirect recursion","recursive"]+    notMacCI $ crash ["systemcmd"] ["systemcmd","random_missing_command", "at cmd, called at"]+    crash ["stack1"] ["stack1","stack2","stack3","crash"]++    b <- IO.doesFileExist "staunch1"+    when b $ removeFile "staunch1"+    crash ["staunch1","staunch2","-j2"] ["crash"]+    assertBoolIO (not <$> IO.doesFileExist "staunch1") "File should not exist, should have crashed first"+    crash ["staunch1","staunch2","-j2","--keep-going","--silent"] ["crash"]+    assertBoolIO (IO.doesFileExist "staunch1") "File should exist, staunch should have let it be created"++    crash ["finally1"] ["die"]+    assertContents "finally1" "1"+    build ["finally2"]+    assertContents "finally2" "1"+    crash ["exception1"] ["die"]+    assertContents "exception1" "1"+    build ["exception2"]+    assertContents "exception2" "0"++    crash ["retry0"] ["positive","0"]+    crash ["retry1"] ["die"]+    build ["retry4"]++    forM_ ["finally3","finally4"] $ \name -> do+        t <- forkIO $ ignore $ build [name,"--exception"]+        retry 10 $ sleep 0.1 >> assertContents name "0"+        throwTo t (IndexOutOfBounds "test")+        retry 10 $ sleep 0.1 >> assertContents name "1"++    crash ["resource"] ["cannot currently introduce a dependency","withResource","resource_name"]++    build ["overlap.foo"]+    assertContents "overlap.foo" "overlap.*"+    build ["overlap.txt"]+    assertContents "overlap.txt" "overlap.txt"+    crash ["overlap.txx"] $+        ["key matches multiple rules","matched:  4","overlap.txx","overlap.t*","overlap.*","*.tox"] +++        ["Test/Errors.hs"]++    crash ["tempfile"] ["tempfile-died"]+    src <- readFile "tempfile"+    assertMissing src+    build ["tempdir"]++    crash ["--die"] ["Shake","death error","Test/Errors.hs"]++    putStrLn "## BUILD errors"+    (out,_) <- IO.captureOutput $ build []+    assertBool ("nothing to do" `isInfixOf` out) $ "Expected 'nothing to do', but got: " ++ out++    putStrLn "## BUILD errors fail1 fail2 -k -j2"+    (out,_) <- IO.captureOutput $ try_ $ build ["fail1","fail2","-k","-j2",""]+    assertBool ("die1" `isInfixOf` out && "die2" `isInfixOf` out) $ "Expected 'die1' and 'die2', but got: " ++ out++    crash ["fresh_dir"] ["expected a file, got a directory","fresh_dir"]+    crash ["need_dir"] ["expected a file, got a directory","existing_dir"]++    -- check errors don't persist to the database, #428+    writeFile "persist_failure.log" ""+    writeFile "persist_failure.3" "test"+    build ["persist_failure.1","--sleep"]+    writeFile "persist_failure.3" "die"+    crash ["persist_failure.1","--sleep"] []+    assertContents "persist_failure.log" "[pre][post][err][pre]"+    writeFile "persist_failure.3" "test"+    build ["persist_failure.1","--sleep"]+    assertContents "persist_failure.log" "[pre][post][err][pre]"+    writeFile "persist_failure.3" "more"+    build ["persist_failure.1"]+    assertContents "persist_failure.log" "[pre][post][err][pre][pre][post]"++    -- check a fast failure aborts a slow success+    (t, _) <- duration $ crash ["fast_failure","slow_success","-j2"] ["die"]+    assertBool (t < 10) $ "Took too long, expected < 10, got " ++ show t++    -- for exceptions on Key we die while reading the database, and restart from scratch+    build ["badinput"]+    build ["badinput","--silent"]+    assertContents "badinput" "xx"+    build ["badnone","--silent"] -- must be able to still run other rules+    assertContents "badnone" "x"++    -- for exceptions on Value we die while running the rule that requires it+    build ["badoutput"]+    crash ["badoutput"] ["badoutput","BadBinary"]+    build ["badnone"] -- must be able to still run other rules+    assertContents "badnone" "xx"++    -- check that produces works+    build ["produces1"]+    crash ["produces2"] ["produces","produces2.also"]++    -- check finally doesn't run twice, See https://github.com/ndmitchell/shake/issues/611+    t <- forkIO $ build ["finalfinal","--quiet"]+    sleep 0.2+    killThread t+    sleep 0.5+    assertContents "finalfinal" "XY"++    build ["catch1"]+    assertContentsInfix "catch1" "magic1"+    crash ["catch2"] [show ThreadKilled]+    crash ["catch3.2"] ["magic3"]
+ src/Test/Existence.hs view
@@ -0,0 +1,28 @@+module Test.Existence(main) where++import Development.Shake+import Development.Shake.Internal.FileInfo+import Development.Shake.Internal.FileName+import System.Directory+import System.FilePath+import General.Extra++main :: IO () -> IO ()+main _ = do+    cwd <- getCurrentDirectory+    someFiles <- getDirectoryFilesIO cwd ["*"]+    let someFile = headErr someFiles+    assertIsJust $ getFileInfo False $ fileNameFromString someFile++    let fileThatCantExist = someFile </> "fileThatCantExist"+    assertIsNothing $ getFileInfo False $ fileNameFromString fileThatCantExist++assertIsJust :: IO (Maybe a) -> IO ()+assertIsJust action = do+    Just _ <- action+    pure ()++assertIsNothing :: IO (Maybe a) -> IO ()+assertIsNothing action = do+    Nothing <- action+    pure ()
+ src/Test/FileLock.hs view
@@ -0,0 +1,39 @@++module Test.FileLock(main) where++import Development.Shake+import Control.Concurrent.Extra+import Control.Exception.Extra+import Control.Monad+import Data.Either.Extra+import System.Time.Extra+import System.Info.Extra+import Test.Type+++main = testBuild test $+    action $ do+        putInfo "Starting sleep"+        liftIO $ sleep 5+        putInfo "Finished sleep"+++-- Disabled under Mac because it fails, see #560+-- Reported as working locally under APFS, so may just be the older HFS+ as used by Travis CI+test build = unless isMac $ do+    -- check it fails exactly once+    time <- offsetTime+    lock <- newLock+    let out msg = do t <- time; withLock lock $ print (t, msg)+    out "before onceFork"+    a <- onceFork $ do out "a1"; build ["-VVV"]; out "a2"+    b <- onceFork $ do out "b1"; build ["-VVV"]; out "b2"+    out "after onceFork"+    a <- try_ a+    out "after try a"+    b <- try_ b+    out "after try b"+    when (length (filter isLeft [a,b]) /= 1) $+        fail $ "Expected one success and one failure, got " ++ show [a,b]+    -- check it succeeds after the lock has been held+    build []
+ src/Test/FilePath.hs view
@@ -0,0 +1,129 @@++module Test.FilePath(main) where++import Development.Shake.FilePath+import Development.Shake+import qualified System.FilePath as Native+import Test.Type+import Test.QuickCheck+import Control.Monad+import Data.List.Extra+import qualified Data.ByteString.Char8 as BS+import qualified Development.Shake.Internal.FileName as BS+import System.Info.Extra+import System.Directory+import qualified System.IO.Extra as IO+import General.Extra+++newtype File = File String deriving Show++instance Arbitrary File where+    arbitrary = fmap File $ listOf $ oneof $ map pure "a /\\:."+    shrink (File x) = map File $ shrink x+++main = testSimple $ do+    let infix 1 ===+        a === b = a Test.Type.=== b -- duplicate definition in QuickCheck 2.7 and above++    let norm x =+            let s = toStandard $ normaliseEx x+                b = BS.unpack (BS.filepathNormalise $ BS.pack x)+            in if s == b then s else error $ show ("Normalise functions differ",x,s,b)++    -- basic examples+    norm "" === "."+    norm "." === "."+    norm "/" === "/"+    norm "./" === "./"+    norm "/." === "/."+    norm "/./" === "/"+    norm "a/." === "a"+    norm "./a" === "a"+    norm "./a/." === "a"+    norm "./a/./" === "a/"+    norm "a/.." === "."+    norm "a/./.." === "."+    norm "a/../" === "./"+    norm "/a/../" === "/"+    norm "/a/./../" === "/"+    norm "../a" === "../a"+    norm "/../a/" === "/../a/"++    -- more realistic examples+    norm "neil//./test/moo/../bar/bob/../foo" === "neil/test/bar/foo"+    norm "bar/foo" === "bar/foo"+    norm "bar/foo/" === "bar/foo/"+    norm "../../foo" === "../../foo"+    norm "foo/../..///" === "../"+    norm "foo/bar/../../neil" === "neil"+    norm "foo/../bar/../neil" === "neil"+    norm "/foo/bar" === "/foo/bar"+    norm "//./" === (if isWindows then "//" else "/")+    norm "//foo/./bar" === (if isWindows then "//foo/bar" else "/foo/bar")+    when isWindows $ norm "c:\\foo\\bar" === "c:/foo/bar"+    when isWindows $ normaliseEx "foo/bar\\baz" === "foo\\bar\\baz"+    Success{} <- quickCheckWithResult stdArgs{maxSuccess=1000} $ \(File x) ->+        let y = norm x+            sep = Native.isPathSeparator+            noDrive = if isWindows then drop1 else id+            ps = [y /= ""+                 ,null x || (sep (headErr x) == sep (headErr y) && sep (last x) == sep (last y))+                 ,not $ "/./" `isInfixOf` y+                 ,not isWindows || '\\' `notElem` y+                 ,not $ "//" `isInfixOf` noDrive y+                 ,".." `notElem` dropWhile (== "..") (dropWhile (\x -> all isPathSeparator x || isDrive x) $ splitDirectories y)+                 ,norm y == y]+        in if and ps then True else error (show (x, y, ps))++    dropDirectory1 "aaa/bbb" === "bbb"+    dropDirectory1 "aaa/" === ""+    dropDirectory1 "aaa" === ""+    dropDirectory1 "" === ""++    takeDirectory1 "aaa/bbb" === "aaa"+    takeDirectory1 "aaa/" === "aaa"+    takeDirectory1 "aaa" === "aaa"++    replaceDirectory1 "root/file.ext" "directory" === "directory" ++ [pathSeparator] ++ "file.ext"+    replaceDirectory1 "root/foo/bar/file.ext" "directory" === "directory" ++ [pathSeparator] ++ "foo/bar/file.ext"++    searchPathSeparator === Native.searchPathSeparator+    pathSeparators === Native.pathSeparators++    if isWindows then+        toNative "//this is a///test\\here/" === "\\\\this is a\\\\\\test\\here\\"+     else+        toNative "//this is a///test\\here/" === "//this is a///test\\here/"++    -- check common manipulations work+    ("//*" <.> "foo") === "//*.foo"+    toStandard ("a" </> "b" </> "c" <//> "*" <.> "exe") === "a/b/c//*.exe"+    ("a" <//> "/b/c") === "a//b/c"++    -- check makeRelativeEx+    IO.withTempDir $ \ cwd -> do+        setCurrentDirectory cwd+        createDirectory (cwd </> "a")+        createDirectory (cwd </> "b")+        writeFile (toNative (cwd </> "b/file.out")) "foo"+        createDirectory (cwd </> "e")+        createDirectory (cwd </> "e/f")+        createDirectory (cwd </> "e/f/g")+        -- on Windows creating symlinks requires additional privileges+        -- so skip the test there++        -- portable symlinks only available on GHC 8.4+        -- unless isWindows $+        --    createFileLink  (cwd </> "e/f/g/") (cwd </> "c")++        let f a b c = makeRelativeEx a (normalise b) >>= (=== fmap normalise c)+        f "/x/y/" "/x/y/z" $ Just "z"+        f (cwd </> "c") "../b/file.out" $ Just "../b/file.out"+        f "a" "b/file.out" $ Just "b/file.out"+        f (cwd </> "a") (cwd </> "b/file.out") $ Just "../b/file.out"+        -- unless isWindows $ do+        --    f (cwd </> "c") (cwd </> "b/file.out") $ Just "../../../b/file.out"+        --    f "c" (cwd </> "b/file.out") $ Just "../../../b/file.out"+        --    f (cwd </> "c/../../../a") (cwd </> "b/file.out") $ Just "../b/file.out"
+ src/Test/FilePattern.hs view
@@ -0,0 +1,215 @@++module Test.FilePattern(main) where++import Development.Shake.Internal.FilePattern+import Development.Shake.FilePath+import Control.Monad+import System.IO.Unsafe+import System.Info.Extra+import Data.List.Extra+import Test.Type+import Test.QuickCheck hiding ((===))++++newtype Pattern = Pattern FilePattern deriving (Show,Eq)+newtype Path    = Path    FilePath    deriving (Show,Eq)++-- Since / and * are the only "interesting" elements, just add ab to round out the set++instance Arbitrary Pattern where+    arbitrary = fmap Pattern $ listOf $ elements "\\/*ab"+    shrink (Pattern x) = map Pattern $ shrinkList (\x -> ['/' | x == '\\']) x++instance Arbitrary Path where+    arbitrary = fmap Path $ listOf $ elements "\\/ab"+    shrink (Path x) = map Path $ shrinkList (\x -> ['/' | x == '\\']) x+++main = testSimple $ do+    internalTest+    let norm = filter (/= ".") . split isPathSeparator+    let f b pat file = do+            assertBool (b == (pat ?== file)) $ show pat ++ " ?== " ++ show file ++ "\nEXPECTED: " ++ show b+            assertBool (b == (pat `walker` file)) $ show pat ++ " `walker` " ++ show file ++ "\nEXPECTED: " ++ show b+            when b $ assertBool (norm (substitute (extract pat file) pat) == norm file) $+                "FAILED substitute/extract property\nPattern: " ++ show pat ++ "\nFile: " ++ show file ++ "\n" +++                "Extracted: " ++ show (extract pat file) ++ "\nSubstitute: " ++ show (substitute (extract pat file) pat)++    f True "//*.c" "foo/bar/baz.c"+    f True "**/*.c" "foo/bar/baz.c"+    f True (toNative "//*.c") "foo/bar\\baz.c"+    f True (toNative "**/*.c") "foo/bar\\baz.c"+    f True "*.c" "baz.c"+    f True "//*.c" "baz.c"+    f True "**/*.c" "baz.c"+    f True "test.c" "test.c"+    f False "*.c" "foor/bar.c"+    f False "*/*.c" "foo/bar/baz.c"+    f False "foo//bar" "foobar"+    f False "foo/**/bar" "foobar"+    f False "foo//bar" "foobar/bar"+    f False "foo/**/bar" "foobar/bar"+    f False "foo//bar" "foo/foobar"+    f False "foo/**/bar" "foo/foobar"+    f True "foo//bar" "foo/bar"+    f True "foo/**/bar" "foo/bar"+    f True "foo/bar" (toNative "foo/bar")+    f True (toNative "foo/bar") "foo/bar"+    f True (toNative "foo/bar") (toNative "foo/bar")+    f True "//*" "/bar"+    f False "**/*" "/bar"+    f True "/bob//foo" "/bob/this/test/foo"+    f True "/bob/**/foo" "/bob/this/test/foo"+    f False "/bob//foo" "bob/this/test/foo"+    f False "/bob/**/foo" "bob/this/test/foo"+    f True "bob//foo/" "bob/this/test/foo/"+    f True "bob/**/foo/" "bob/this/test/foo/"+    f False "bob//foo/" "bob/this/test/foo"+    f False "bob/**/foo/" "bob/this/test/foo"+    f True "a//" "a"+    f True "a/**" "a"+    f True "/a//" "/a"+    f True "/a/**" "/a"+    f True "///a//" "/a"+    f False "**/a/**" "/a"+    f False "///" ""+    f True "///" "/"+    f True "/**" "/"+    f True "///" "a/"+    f True "**/" "a/"+    f True "////" ""+    f True "**/**" ""+    f True "x///y" "x/y"+    f True "x/**/y" "x/y"+    f True "x///" "x/"+    f True "x/**/" "x/"+    f True "x///" "x/foo/"+    f True "x/**/" "x/foo/"+    f False "x///" "x"+    f False "x/**/" "x"+    f True "x///" "x/foo/bar/"+    f True "x/**/" "x/foo/bar/"+    f False "x///" "x/foo/bar"+    f False "x/**/" "x/foo/bar"+    f True "x///y" "x/z/y"+    f True "x/**/*/y" "x/z/y"+    f True "" ""+    f False "" "y"+    f False "" "/"++    f True "*/*" "x/y"+    f False "*/*" "x"+    f True "//*" "x"+    f True "**/*" "x"+    f True "//*" ""+    f True "**/*" ""+    f True "*//" "x"+    f True "*/**" "x"+    f True "*//" ""+    f True "*/**" ""+    f True "*//*" "x/y"+    f True "*/**/*" "x/y"+    f False "*//*" ""+    f False "*/**/*" ""+    f False "*//*" "x"+    f False "*/**/*" "x"+    f False "*//*//*" "x/y"+    f False "*/**/*/**/*" "x/y"+    f True "//*/" "/"+    f False "**/*/" "/"+    f True "*/////" "/"+    f True "*/**/**/" "/"+    f False "b*b*b*//" "bb"+    f False "b*b*b*/**" "bb"++    f False "**" "/"+    f False "**/x" "/x"+    f True "**" "x/"+    f (not isWindows) "**" "\\\\drive"+    f (not isWindows) "**" "C:\\drive"+    f (not isWindows) "**" "C:drive"++    -- We support ignoring '.' values in FilePath as they are inserted by @filepath@ a lot+    f True "./file" "file"+    f True ("" </> "file") "file"+    f True "foo/./bar" "foo/bar"+    f True "foo/./bar" "foo/./bar"+    f False "foo/./bar" "foo/bob"++    filePattern "**/*.c" "test.txt" === Nothing+    filePattern "**/*.c" "foo.c" === Just ["","foo"]+    filePattern "**/*.c" "bar/baz/foo.c" === Just ["bar/baz/","foo"]+    filePattern "**/*.c" "bar\\baz\\foo.c" === Just+        (if isWindows then ["bar/baz/","foo"] else ["","bar\\baz\\foo"])++    simple "a*b" === False+    simple "a//b" === False+    simple "a/**/b" === False+    simple "/a/b/cccc_" === True+    simple "a///b" === False+    simple "a/**/b" === False++    assertBool (compatible []) "compatible"+    assertBool (compatible ["//*a.txt","foo//a*.txt"]) "compatible"+    assertBool (compatible ["**/*a.txt","foo/**/a*.txt"]) "compatible"+    assertBool (compatible ["//*a.txt","foo/**/a*.txt"]) "compatible"+    assertBool (not $ compatible ["//*a.txt","foo//a*.*txt"]) "compatible"+    assertBool (not $ compatible ["**/*a.txt","foo/**/a*.*txt"]) "compatible"+    extract "//*a.txt" "foo/bar/testa.txt" === ["foo/bar/","test"]+    extract "**/*a.txt" "foo/bar/testa.txt" === ["foo/bar/","test"]+    extract "//*a.txt" "testa.txt" === ["","test"]+    extract "**/*a.txt" "testa.txt" === ["","test"]+    extract "//a.txt" "a.txt" === [""]+    extract "**/a.txt" "a.txt" === [""]+    extract "//a.txt" "/a.txt" === ["/"]+    extract "a//b" "a/b" === [""]+    extract "a/**/b" "a/b" === [""]+    extract "a//b" "a/x/b" === ["x/"]+    extract "a/**/b" "a/x/b" === ["x/"]+    extract "a//b" "a/x/y/b" === ["x/y/"]+    extract "a/**/b" "a/x/y/b" === ["x/y/"]+    extract "a///b" "a/x/y/b" === ["x/y/"]+    extract "a/**/**/b" "a/x/y/b" === ["","x/y/"]+    extract "//*a*.txt" "testada.txt" === ["","test","da"]+    extract "**/*a*.txt" "testada.txt" === ["","test","da"]+    extract (toNative "//*a*.txt") "testada.txt" === ["","test","da"]+    extract (toNative "**/*a*.txt") "testada.txt" === ["","test","da"]+    substitute ["","test","da"] "//*a*.txt" === "testada.txt"+    substitute ["","test","da"] "**/*a*.txt" === "testada.txt"+    substitute  ["foo/bar/","test"] "//*a.txt" === "foo/bar/testa.txt"+    substitute  ["foo/bar/","test"] "**/*a.txt" === "foo/bar/testa.txt"++    (False, Walk _) <- pure $ walk ["*.xml"]+    (False, Walk _) <- pure $ walk ["//*.xml"]+    (False, Walk _) <- pure $ walk ["**/*.xml"]+    (False, WalkTo ([], [("foo",Walk _)])) <- pure $ walk ["foo//*.xml"]+    (False, WalkTo ([], [("foo",Walk _)])) <- pure $ walk ["foo/**/*.xml"]+    (False, WalkTo ([], [("foo",WalkTo ([],[("bar",Walk _)]))])) <- pure $ walk ["foo/bar/*.xml"]+    (False, WalkTo (["a"],[("b",WalkTo (["c"],[]))])) <- pure $ walk ["a","b/c"]+    ([], [("foo",WalkTo ([],[("bar",Walk _)]))]) <- let (False, Walk f) = walk ["*/bar/*.xml"] in pure $ f ["foo"]+    (False, WalkTo ([],[("bar",Walk _),("baz",Walk _)])) <- pure $ walk ["bar/*.xml","baz//*.c"]+    (False, WalkTo ([],[("bar",Walk _),("baz",Walk _)])) <- pure $ walk ["bar/*.xml","baz/**/*.c"]+    (False, WalkTo ([], [])) <- pure $ walk []+    (True, Walk _) <- pure $ walk ["//"]+    (True, Walk _) <- pure $ walk ["**"]+    (True, WalkTo _) <- pure $ walk [""]++    Success{} <- quickCheckWithResult stdArgs{maxSuccess=1000} $ \(Pattern p) (Path x) ->+        let label _ = property in+            -- Ignore label to workaround QuickCheck space-leak+            -- See #450 and https://github.com/nick8325/quickcheck/pull/93+        let b = p ?== x in (if b then property else label "No match") $ unsafePerformIO $ do f b p x; pure True+    pure ()+++walker :: FilePattern -> FilePath -> Bool+-- Slight difference of opinion since Walker is always relative to something+walker a b | isRelativePattern a, not $ isRelativePath b = False+walker a b = f (split isPathSeparator b) $ snd $ walk [a]+    where+        f (".":xs) w = f xs w+        f (x:xs) (Walk op) = f (x:xs) $ WalkTo $ op [x]+        f [x]    (WalkTo (file, _  )) = x `elem` file+        f (x:xs) (WalkTo (_   , dir)) | Just w <- lookup x dir = f xs w+        f _ _ = False
+ src/Test/Files.hs view
@@ -0,0 +1,64 @@++module Test.Files(main) where++import Development.Shake+import Development.Shake.FilePath+import System.Directory+import Test.Type+import Control.Monad+import Data.List+++main = testBuild test $ do+    want ["even.txt","odd.txt"]++    "A1-plus-B" %> \out -> do+        a1 <- readFileLines "A1"+        b  <- readFileLines "B"+        writeFileLines out $ a1 ++ b++    ["A1", "A2"] &%> \[o1, o2] -> do+        writeFileLines o1 ["This is", "A1"]+        writeFileLines o2 ["This is", "A2"]++    "B" %> \out ->+        writeFileLines out ["This is", "B"]++    ["even.txt","odd.txt"] &?%> \[evens,odds] -> do+        src <- readFileLines "numbers.txt"+        let (es,os) = partition even $ map read src+        writeFileLines evens $ map show es+        writeFileLines odds  $ map show os++    ["dir1/out.txt","dir2/out.txt"] &?%> \[a,b] -> do+        writeFile' a "a"+        writeFile' b "b"++    ["or1.txt","or2.txt","or*.txt"] |%> \x ->+        writeFile' x x++    (\x -> let dir = takeDirectory x in+           if takeFileName dir /= "pred" then Nothing else Just [dir </> "a.txt",dir </> "b.txt"]) &?> \outs ->+        mapM_ (`writeFile'` "") outs+++test build = do+    forM_ [[],["--usepredicate"]] $ \args -> do+        let nums = unlines . map show+        writeFile "numbers.txt" $ nums [1,2,4,5,2,3,1]+        build ("--sleep":args)+        assertContents "even.txt" $ nums [2,4,2]+        assertContents "odd.txt"  $ nums [1,5,3,1]+        build ["clean"]+        build ["--no-build","--report=-"]+        build ["dir1/out.txt"]++    build ["pred/a.txt"]++    -- Test #496+    build ["A1-plus-B"]+    removeFile "A2"+    build ["A1-plus-B"]++    build ["or2.txt","or4.txt"]+    assertContents "or4.txt" "or4.txt"
+ src/Test/Forward.hs view
@@ -0,0 +1,65 @@++module Test.Forward(main) where++import Data.Char+import Data.List.Extra+import Development.Shake+import System.Info.Extra+import Development.Shake.Forward+import Development.Shake.FilePath+import Test.Type+import System.IO.Extra as IO+++main = testBuild test $ forwardRule $ do+    cs <- getDirectoryFiles "" ["*.c"]+    os <- forP cs $ \c -> do+        let o = c <.> "o"+        cache $ cmd "gcc -c" [c] "-o" [o]+        pure o+    cache $ cmd "gcc -o" ["Main" <.> exe] os+    cache $ cmd ["." </> "Main" <.> exe] (FileStdout "output.txt")++    -- Doing this way to test cacheAction with arguments+    -- any real code should use a tracked readFile and avoid passing arguments to the closure+    src <- liftIO $ IO.readFile' "output.txt"+    cacheActionWith "reducer" src $ writeFile' "out.txt" $ filter isUpper src+++checkVaild act = do+    b <- hasTracker+    if not b then+        putStrLn "Warning: Not running forward test (no tracker)"+     else if isMac then+        putStrLn "Warning: Not running forward test (doesn't work on Mac)"+     else+        act++test build = checkVaild $ do+    -- first clean then copy the source files over+    build ["clean"]+    copyDirectoryChanged (shakeRoot </> "src/Test/C") "."++    -- build and rebuild+    build ["--forward"]+    assertContents "output.txt" "Hello Shake Users!\n"+    assertContents "out.txt" "HSU"++    -- check that cacheAction doesn't rerun when it shouldn't+    writeFile "out.txt" "HHH"+    build ["-j2","--forward"]+    assertContents "output.txt" "Hello Shake Users!\n"+    assertContents "out.txt" "HHH"++    -- modify the constants+    orig <- IO.readFile' "constants.c"+    writeFile "constants.c" $ replace "Shake" "Rattle" orig+    build ["-j2","--forward"]+    assertContents "output.txt" "Hello Rattle Users!\n"+    assertContents "out.txt" "HRU"++    -- put it back+    writeFile "constants.c" orig+    build ["-j2","--forward"]+    assertContents "output.txt" "Hello Shake Users!\n"+    assertContents "out.txt" "HSU"
+ src/Test/History.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -Wno-orphans #-}++module Test.History(main) where++import Control.Monad.Extra+import Development.Shake+import Test.Type+import General.Extra+import General.GetOpt+import System.Directory+import Development.Shake.Internal.History.Symlink+++data Args = Die deriving (Eq,Enum,Bounded,Show)++type instance RuleResult FilePath = String++main = testBuildArgs test optionsEnum $ \args -> do+    let die :: a -> a+        die x = if Die `elem` args then error "Die" else x++    phony "Phony" $ pure ()+    "Phony.txt" %> \out -> do+        need ["Phony"]+        copyFile' "In.txt" out++    "OutFile.txt" %> \out -> die $ copyFile' "In.txt" out++    "OutFile.link.txt" %> \out -> die $ do+        need ["In.txt"]+        whenJustM (liftIO $ createLinkMaybe "In.txt" out) $ \_ ->+            -- just is equivalent to an error happening, so just copy the file+            writeFile' out =<< readFile' "In.txt"++    reader <- addOracleCache $ \x -> die (readFile' x)+    "OutOracle.txt" %> \out -> do+        historyDisable+        writeFile' out =<< reader "In.txt"++    ["OutFiles1.txt","OutFiles2.txt"] &%> \[out1, out2] -> die $ do+        copyFile' "In.txt" out1+        copyFile' "In.txt" out2++test build =+    forM_ [[],["--share-copy"]] $ \args -> do+        let setIn = writeFile "In.txt"+        let outs = ["OutFile.txt","OutOracle.txt","OutFiles1.txt","OutFiles2.txt","Phony.txt"] -- ,"OutFile.link.txt"]+        let checkOut x = mapM_ (`assertContents` x) outs++        build ["clean"]+        setIn "1"+        build $ args ++ ["--share","--sleep"] ++ outs+        checkOut "1"+        setIn "2"+        build $ args ++ ["--share","--sleep"] ++ outs+        checkOut "2"++        setIn "1"+        assertException [] $ build ["OutFile.txt","--die","--quiet","--sleep"]+        build $ args ++ ["--die","--share"] ++ outs+        checkOut "1"++        setIn "2"+        mapM_ removeFile_ outs+        build $ args ++ ["--die","--share"] ++ outs+        checkOut "2"++        setIn "2"+        removeFile ".shake.database"+        build $ args ++ ["--die","--share"] ++ outs+        checkOut "2"
+ src/Test/Journal.hs view
@@ -0,0 +1,43 @@++module Test.Journal(main) where++import Control.Monad+import Data.IORef+import Development.Shake+import Development.Shake.FilePath+import Test.Type+import System.IO.Unsafe+++{-# NOINLINE rebuilt #-}+rebuilt :: IORef Int+rebuilt = unsafePerformIO $ newIORef 0+++main = testBuild test $ do+    want ["a.out","b.out","c.out"]+    "*.out" %> \out -> do+        liftIO $ atomicModifyIORef rebuilt $ \a -> (a+1,())+        copyFile' (out -<.> "in") out+++test build = do+    let change x = writeFile (x <.> "in") x+    let count x = do+            before <- readIORef rebuilt+            build ["--sleep"]+            after <- readIORef rebuilt+            x === after - before++    change "a"+    change "b"+    change "c"+    count 3++    -- test that compressing the database doesn't corrupt anything+    replicateM_ 4 $ do+        change "a"+        count 1+        change "a"+        change "c"+        count 2
+ src/Test/Lint.hs view
@@ -0,0 +1,158 @@+{-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving, DeriveDataTypeable #-}++module Test.Lint(main) where++import Development.Shake+import Development.Shake.Classes+import Development.Shake.FilePath+import General.Extra+import Test.Type+import Control.Exception+import System.Directory as IO+import System.Info.Extra+import Control.Monad.Extra++newtype Zero = Zero () deriving (Eq, Show, NFData, Typeable, Hashable, Binary)++type instance RuleResult Zero = Zero++main = testBuild test $ do+    addOracle $ \Zero{} -> do+        liftIO $ createDirectoryRecursive "dir"+        liftIO $ setCurrentDirectory "dir"+        pure $ Zero ()++    "changedir" %> \out -> do+        Zero () <- askOracle $ Zero ()+        writeFile' out ""++    "pause.*" %> \out -> do+        liftIO $ sleep 0.2+        need ["cdir" <.> takeExtension out]+        writeFile' out ""++    "cdir.*" %> \out -> do+        pwd <- liftIO getCurrentDirectory+        let dir2 = "dir" ++ takeExtension out+        liftIO $ createDirectoryRecursive dir2+        liftIO $ setCurrentDirectory dir2+        liftIO $ sleep 0.4+        liftIO $ setCurrentDirectory pwd+        writeFile' out ""++    "createonce" %> \out ->+        writeFile' out "X"++    "createtwice" %> \out -> do+        need ["createonce"]+        liftIO sleepFileTime+        writeFile' "createonce" "Y"+        writeFile' out ""++    "recordtwice" %> \out -> do+        alwaysRerun+        trackWrite ["recordtwice_"]+        trackWrite ["recordtwice_"]+        writeFile' "recordtwice_" ""+        writeFile' out ""++    "listing" %> \out -> do+        writeFile' (out <.> "ls1") ""+        getDirectoryFiles "" ["//*.ls*"]+        writeFile' (out <.> "ls2") ""+        writeFile' out ""++    "existance" %> \out -> do+        Development.Shake.doesFileExist "exists"+        writeFile' "exists" ""+        writeFile' out ""++    "gen*" %> \out ->+        writeFile' out out++    "needed1" %> \out -> do+        needed ["gen1"]+        writeFile' out ""++    "needed2" %> \out -> do+        orderOnly ["gen2"]+        needed ["gen2"]+        writeFile' out ""++    "tracker-write1" %> \out -> do+        gen "x" $ out <.> "txt"+        need [out <.> "txt"]+        writeFile' out ""++    "tracker-write2" %> \out -> do+        gen "x" $ out <.> "txt"+        writeFile' out ""++    "tracker-source2" %> \out -> copyFile' "tracker-source1" out+    "tracker-read1" %> \out -> do+        access "tracker-source1"+        writeFile' out ""+    "tracker-read2" %> \out -> do+        access "tracker-source1"+        need ["tracker-source1"]+        writeFile' out ""+    "tracker-read3" %> \out -> do+        access "tracker-source2"+        need ["tracker-source2"]+        writeFile' out ""++    "tracker-compile.o" %> \out -> do+        need ["tracker-source.c", "tracker-source.h"]+        cmd "gcc" ["-c", "tracker-source.c", "-o", out]++    "tracker-compile-auto.o" %> \out -> do+        need ["tracker-source.c"]+        cmd AutoDeps "gcc" ["-c", "tracker-source.c", "-o", out]++    "../lint2/tracker-relative" %> \out ->+        writeFile' out "tracker-relative"+    "tracker-relative1" %> \out -> do+        need ["../lint2/tracker-relative"]+        access "../lint2/tracker-relative"+        writeFile' out "tracker-relative"+    "tracker-relative2" %> \out -> do+        access "../lint2/tracker-relative"+        writeFile' out "tracker-relative"++    where gen t f = cmd Shell "echo" t ">" (toNative f) :: Action ()+          access f = if isWindows+                     then cmd_ Shell "type" (toNative f) "> nul"+                     else cmd_ Shell "cat" f "> /dev/null"+++test build = do+    dir <- getCurrentDirectory+    let crash args parts =+            assertException parts (build $ "--quiet" : args)+                `finally` setCurrentDirectory dir++    crash ["changedir"] ["current directory has changed"]+    build ["cdir.1","cdir.2","-j1"]+    build ["--clean","cdir.1","pause.2","-j1"]+    crash ["--clean","cdir.1","pause.2","-j2"] ["output","lint","current directory has changed"]+    crash ["existance"] ["changed since being depended upon"]+    crash ["createtwice"] ["changed since being depended upon"]+    build ["recordtwice"]+    crash ["listing"] ["changed since being depended upon","listing.ls2"]+    crash ["--clean","listing","existance"] ["changed since being depended upon"]+    crash ["needed1"] ["'needed' file required rebuilding"]+    build ["needed2"]+    whenM hasTracker $ do+        writeFile "tracker-source1" ""+        writeFile "tracker-source2" ""+        writeFile "tracker-source.c" "#include <stdio.h>\n#include \"tracker-source.h\"\n"+        writeFile "tracker-source.h" ""+        crash ["tracker-write1"] ["not have its creation tracked","tracker-write1","tracker-write1.txt"]+        build ["tracker-write2"]+        crash ["tracker-read1"] ["used but not depended upon","tracker-source1"]+        build ["tracker-read2"]+        crash ["tracker-read3"] ["depended upon after being used","tracker-source2"]+        build ["tracker-compile.o"]+        build ["tracker-compile-auto.o"]+        build ["tracker-relative1"]+        crash ["tracker-relative2"] ["lint2/tracker-relative"]
+ src/Test/Live.hs view
@@ -0,0 +1,26 @@++module Test.Live(main) where++import Development.Shake+import Test.Type+++main = testBuild test $ do+    "foo" %> \ out -> do+        need ["bar"]+        writeFile' out ""++    "bar" %> \out -> writeFile' out ""+    "baz" %> \out -> writeFile' out ""+++test build = do+    build ["clean"]+    build ["foo","baz","--live=live.txt"]+    assertContentsUnordered "live.txt" $ words "foo bar baz"+    build ["foo","baz","--live=live.txt"]+    assertContentsUnordered "live.txt" $ words "foo bar baz"+    build ["foo","--live=live.txt"]+    assertContentsUnordered "live.txt" $ words "foo bar"+    build ["bar","--live=live.txt"]+    assertContentsUnordered "live.txt" $ words "bar"
+ src/Test/Manual.hs view
@@ -0,0 +1,27 @@++module Test.Manual(main) where++import Development.Shake+import Development.Shake.FilePath+import Test.Type+import General.Extra+import Data.Maybe+import System.Info.Extra+++main = testSimple $ do+    -- we use .git as our destination, despite not being a real git repo+    -- so that search tools ignore it, and I don't get dupes for every source file+    let dest = ".git"+    copyDirectoryChanged (shakeRoot </> "docs/manual") dest+    copyDirectoryChanged (shakeRoot </> "src/Development") $ dest </> "Development"+    copyDirectoryChanged (shakeRoot </> "src/General") $ dest </> "General"+    copyFileChangedIO (shakeRoot </> "src/Paths.hs") $ dest </> "Paths_shake.hs"+    (_, gccPath) <- findGcc+    let opts = [Cwd dest, Shell, AddPath [] (maybeToList gccPath)]+    let cmdline = if isWindows then "build.bat" else "/bin/sh build.sh"+    cmd_ opts cmdline "-j2"+    assertExists $ dest </> "_build/run" <.> exe+    cmd_ opts cmdline+    cmd_ opts [cmdline,"clean"]+    assertMissing $ dest </> "_build/run" <.> exe
+ src/Test/Match.hs view
@@ -0,0 +1,63 @@++-- | Test the rule matching facilities - alternatives, priority etc.+module Test.Match(main) where++import Development.Shake+import Test.Type+++main = testBuild test $ do+    let output x file = writeFile' file x++    ["or*","*or"] |%> output ""++    alternatives $ do+        "alternative.t*" %> output "alternative.t*"+        "alternative.*" %> output "alternative.*"++    priority 100 $ priority 0 $ "priority.txt" %> output "100"+    priority 50 $ "priority.txt" %> output "50"++    alternatives $ do+        priority 20 $ "altpri.txt" %> output "20"+        priority 40 $ "altpri.txt" %> output "40"+    priority 30 $ "altpri.txt" %> output "30"++    alternatives $ do+        priority 21 $ "altpri2.txt" %> output "21"+        priority 22 $ "altpri2.txt" %> output "22"+    priority 23 $ "altpri2.txt" %> output "23"++    priority 55 $ alternatives $ "x" %> output "55"+    priority 51 $ "x" %> output "51"++    priority 42 $ alternatives $ "xx" %> output "42"+    priority 43 $ "xx" %> output "43"++    priority 10 $ do+        priority 6 $ "change" %> output "6"+        priority 7 $ "change" %> output "7"+        priority 8 $ "change" %> output "8"+    priority 9 $ "change" %> output "9"+++test build = do+    build ["clean"]+    build ["or"]++    build ["alternative.foo","alternative.txt"]+    assertContents "alternative.foo" "alternative.*"+    assertContents "alternative.txt" "alternative.t*"++    build ["priority.txt"]+    assertContents "priority.txt" "100"++    build ["altpri.txt","altpri2.txt"]+    assertContents "altpri.txt" "30"+    assertContents "altpri2.txt" "23"++    build ["x","xx"]+    assertContents "x" "55"+    assertContents "xx" "43"++    assertException ["matches multiple rules","3"] $ build ["change","--quiet"]
+ src/Test/Monad.hs view
@@ -0,0 +1,99 @@++module Test.Monad(main) where++import Test.Type+import Development.Shake.Internal.Core.Monad++import Data.Either.Extra+import Data.IORef+import Control.Concurrent+import Control.Exception+import Control.Monad.Extra+import Control.Monad.IO.Class+++++run :: ro -> rw -> RAW () () ro rw a -> IO a+run ro rw m = do+    res <- newEmptyMVar+    runRAW pure ro rw m $ void . tryPutMVar res+    eitherM throwIO pure (readMVar res)+++main = testSimple $ do+    let conv x = mapLeft fromException x :: Either (Maybe ArithException) Int+    let dump rw = liftIO . (=== rw) =<< getRW++    -- test the basics plus exception handling+    run 1 "test" $ do+        dump "test"+        putRW "more"+        dump "more"+        res <- tryRAW $ do+            dump "more"+            modifyRW (++ "x")+            dump "morex"+            pure 100+        liftIO $ conv res === Right 100+        dump "morex"+        putRW "new"+        dump "new"+        res <- tryRAW $ do+            dump "new"+            modifyRW (++ "z")+            dump "newz"+            throwRAW Overflow+            error "Should not have reached here"+            pure 9+        liftIO $ conv res === Left (Just Overflow)+        dump "newz"+        catchRAW (catchRAW (throwRAW Overflow) $ \_ -> modifyRW (++ "x")) $+            \_ -> modifyRW (++ "y")+        dump "newzx"+        catchRAW (catchRAW (throwRAW Overflow) $ \e -> modifyRW (++ "x") >> throwRAW e) $+            \_ -> modifyRW (++ "y")+        dump "newzxxy"++    -- test capture+    run 1 "test" $ do+        i <- captureRAW $ \k -> k $ Right 1+        liftIO $ i === 1+        i <- tryRAW $ captureRAW $ \k -> k $ Left $ toException Overflow+        liftIO $ conv i === Left (Just Overflow)+        captureRAW $ \k -> k $ Right ()+        i <- tryRAW $ throwRAW Underflow+        liftIO $ conv i === Left (Just Underflow)++    -- catch does not scope too far+    res <- try $ run 1 "test" $+        fmap (either show id) $ tryRAW $ captureRAW $ \_ -> throwIO Overflow+    res === Left Overflow+    res <- try $ run 1 "test" $ do+        captureRAW $ \_ -> throwIO Overflow+        pure "x"+    res === Left Overflow+    -- test for GHC bug 11555+    runRAW pure 1 "test" (throw Overflow :: RAW () () Int String ()) $ \res ->+        mapLeft fromException res === Left (Just Overflow)++    -- catch works properly if continuation called multiple times+    ref <- newIORef []+    run 1 "test" $+        flip catchRAW (const $ liftIO $ modifyIORef ref ('x':)) $ do+            captureRAW $ \k -> do+                k $ Right ()+                k $ Right ()+                k $ Left $ toException Overflow+                k $ Right ()+                k $ Left $ toException Overflow+            flip catchRAW (const $ liftIO $ modifyIORef ref ('y':)) $ throwRAW $ toException Overflow+    (===) "xyxyy" =<< readIORef ref++    -- what if we throw an exception inside the continuation of run+    ref <- newIORef 0+    res <- try $ runRAW pure 1 "test" (pure 1) $ \_ -> do+        modifyIORef ref (+1)+        throwIO Overflow+    res === Left Overflow+    (=== 1) =<< readIORef ref
+ src/Test/Ninja.hs view
@@ -0,0 +1,132 @@++module Test.Ninja(main) where++import Development.Shake+import qualified Development.Shake.Config as Config+import System.Directory(copyFile, removeFile)+import Control.Monad+import General.GetOpt+import General.Extra+import Test.Type+import qualified Data.HashMap.Strict as Map+import Data.List.Extra+import System.IO.Extra+import qualified Run+import System.Environment+++opts = Option "" ["arg"] (ReqArg Right "") ""++-- | Set to True to test with real Ninja+--   On Windows doesn't work because echo foo > 1 isn't supported+real_ninja = False++main = testBuildArgs test [opts] $ \opts -> do+    let real = "real" `elem` opts+    action $ if real || real_ninja+        then cmd "ninja" opts+        else liftIO $ withArgs ("--lint":"--report=report.html":opts) Run.main+++test build = do+    let runEx ninja shake = build $ "--exception" : "--no-report" : map ("--arg=" ++) (words ninja) ++ words shake+    let run ninja = runEx ninja []+    let runFail ninja bad = assertException [bad] $ runEx ninja "--quiet"++    build ["clean"]+    run "-f../../src/Test/Ninja/test1.ninja"+    assertExists "out1.txt"++    run "-f../../src/Test/Ninja/test2.ninja"+    assertExists "out2.2"+    assertMissing "out2.1"+    build ["clean"]+    run "-f../../src/Test/Ninja/test2.ninja out2.1"+    assertExists "out2.1"+    assertMissing "out2.2"++    copyFile "../../src/Test/Ninja/test3-sub.ninja" "test3-sub.ninja"+    copyFile "../../src/Test/Ninja/test3-inc.ninja" "test3-inc.ninja"+    createDirectoryRecursive "subdir"+    copyFile "../../src/Test/Ninja/subdir/1.ninja" "subdir/1.ninja"+    copyFile "../../src/Test/Ninja/subdir/2.ninja" "subdir/2.ninja"+    run "-f../../src/Test/Ninja/test3.ninja"+    assertContentsWords "out3.1" "g4+b1+++i1"+    assertContentsWords "out3.2" "g4++++i1"+    assertContentsWords "out3.3" "g4++++i1"+    assertContentsWords "out3.4" "g4+++s1+s2"++    run "-f../../src/Test/Ninja/test4.ninja out"+    assertExists "out.txt"+    assertExists "out2.txt"++    run "-f../../src/Test/Ninja/test5.ninja"+    assertExists "output file"++    -- #565, check multi-file rules that don't create their contents+    run "-f../../src/Test/Ninja/test7.ninja"++    writeFile "nocreate.log" ""+    writeFile "nocreate.in" ""+    run "-f../../src/Test/Ninja/nocreate.ninja"+    assertContentsWords "nocreate.log" "x"+    run "-f../../src/Test/Ninja/nocreate.ninja"+    run "-f../../src/Test/Ninja/nocreate.ninja"+    assertContentsWords "nocreate.log" "x x x"++    writeFile "input" ""+    runFail "-f../../src/Test/Ninja/lint.ninja bad --lint" "'needed' file required rebuilding"+    run "-f../../src/Test/Ninja/lint.ninja good --lint"+    runFail "-f../../src/Test/Ninja/lint.ninja bad --lint" "not a pre-dependency"++    res <- fmap (drop1 . lines . fst) $ captureOutput $ runEx "-f../../src/Test/Ninja/compdb.ninja -t compdb cxx" "--quiet"+    want <- lines <$> readFile "../../src/Test/Ninja/compdb.output"+    let eq a b | (a1,'*':a2) <- break (== '*') a = unless (a1 `isPrefixOf` b && a2 `isSuffixOf` b) $ a === b+               | otherwise = a === b+    length want === length res+    zipWithM_ eq want res++    -- Test initial variable bindings and variables in include/subninja statements+    let test6 = "test6"++    copyFile "../../src/Test/Ninja/test6-sub.ninja" $ test6 ++ "-sub.ninja"+    copyFile "../../src/Test/Ninja/test6-inc.ninja" $ test6 ++ "-inc.ninja"+    copyFile "../../src/Test/Ninja/test6.ninja" $ test6 ++ ".ninja"++    config <- Config.readConfigFileWithEnv [("v1", test6)] $ test6 ++ ".ninja"+    -- The file included by subninja should have a separate variable scope+    Map.lookup "v2" config === Just "g2"++    run "-f../../src/Test/Ninja/phonyorder.ninja bar.txt"++    -- tests from ninjasmith: https://github.com/ndmitchell/ninjasmith/+    run "-f../../src/Test/Ninja/redefine.ninja"+    assertContentsWords "redefine.txt" "version3 version2"++    run "-f../../src/Test/Ninja/buildseparate.ninja"+    assertContentsWords "buildseparate.txt" "XX"++    run "-f../../src/Test/Ninja/lexical.ninja"+    assertContentsWords "lexical.txt" "XFoo_BarXXFooX.bar"++    run "-f../../src/Test/Ninja/continuations.ninja"+    assertExists "continuations.txt"++    copyFile "../../src/Test/Ninja/restart.ninja" "restart.ninja"+    runEx "-frestart.ninja" "--sleep"+    assertExists "restart.txt"++    createDirectoryRecursive "directory1"+    createDirectoryRecursive "directory2"+    run "-f../../src/Test/Ninja/allow_directory.ninja"++    when False $ do+        -- currently fails because Shake doesn't match Ninja here+        run "-f../../src/Test/Ninja/outputtouch.ninja"+        assertContentsWords "outputtouch.txt" "hello"+        writeFile "outputtouch.txt" "goodbye"+        run "-f../../src/Test/Ninja/outputtouch.ninja"+        assertContentsWords "outputtouch.txt" "goodbye"+        removeFile "outputtouch.txt"+        run "-f../../src/Test/Ninja/outputtouch.ninja"+        assertContentsWords "outputtouch.txt" "hello"
+ src/Test/Ninja/allow_directory.ninja view
@@ -0,0 +1,6 @@+rule create+    command = echo 1 > $out++build root: phony || allow_directory.txt directory1+build allow_directory.txt: create | directory2+default root
+ src/Test/Ninja/buildseparate.ninja view
@@ -0,0 +1,10 @@++rule record+    # produces XX+    command = hello+    command = echo $vBar $command > $out++build buildseparate.txt: record+    vFoo = foo+    vBar = bar+    vBar = X${vFoo}${vBar}X
+ src/Test/Ninja/compdb.ninja view
@@ -0,0 +1,45 @@+# Copied from the Ninja repo++ninja_required_version = 1.3++builddir = build+cxx = g+++ar = ar+cflags = -g -Wall -Wextra -Wno-deprecated -Wno-unused-parameter -fno-rtti $+    -fno-exceptions -pipe -Wno-missing-field-initializers $+    -DNINJA_PYTHON="python.exe" -O2 -DNDEBUG -D_WIN32_WINNT=0x0501+ldflags = -L$builddir -static++rule cxx+  command = $cxx -MMD -MT $out -MF $out.d $cflags -c $in -o $out+  description = CXX $out+  depfile = $out.d+  deps = gcc++rule ar+  command = cmd /c $ar cqs $out.tmp $in && move /Y $out.tmp $out+  description = AR $out++rule link+  command = $cxx $ldflags -o $out $in $libs+  description = LINK $out++# the depfile parser and ninja lexers are generated using re2c.++# Core source files all build into ninja library.+build $builddir\build.o: cxx src\build.cc+build $builddir\build_log.o: cxx src\build_log.cc+build $builddir\clean.o: cxx src\clean.cc++rule doxygen+  command = doxygen $in+  description = DOXYGEN $in+doxygen_mainpage_generator = src\gen_doxygen_mainpage.sh+rule doxygen_mainpage+  command = $doxygen_mainpage_generator $in > $out+  description = DOXYGEN_MAINPAGE $out+build $builddir\doxygen_mainpage: doxygen_mainpage README COPYING | $+    $doxygen_mainpage_generator+build doxygen: doxygen doc\doxygen.config | $builddir\doxygen_mainpage++default ninja.exe
+ src/Test/Ninja/compdb.output view
@@ -0,0 +1,17 @@+[+  {+    "directory": "*",+    "command": "g++ -MMD -MT build\\build.o -MF build\\build.o.d -g -Wall -Wextra -Wno-deprecated -Wno-unused-parameter -fno-rtti -fno-exceptions -pipe -Wno-missing-field-initializers -DNINJA_PYTHON=\"python.exe\" -O2 -DNDEBUG -D_WIN32_WINNT=0x0501 -c src\\build.cc -o build\\build.o",+    "file": "src\\build.cc"+  },+  {+    "directory": "*",+    "command": "g++ -MMD -MT build\\build_log.o -MF build\\build_log.o.d -g -Wall -Wextra -Wno-deprecated -Wno-unused-parameter -fno-rtti -fno-exceptions -pipe -Wno-missing-field-initializers -DNINJA_PYTHON=\"python.exe\" -O2 -DNDEBUG -D_WIN32_WINNT=0x0501 -c src\\build_log.cc -o build\\build_log.o",+    "file": "src\\build_log.cc"+  },+  {+    "directory": "*",+    "command": "g++ -MMD -MT build\\clean.o -MF build\\clean.o.d -g -Wall -Wextra -Wno-deprecated -Wno-unused-parameter -fno-rtti -fno-exceptions -pipe -Wno-missing-field-initializers -DNINJA_PYTHON=\"python.exe\" -O2 -DNDEBUG -D_WIN32_WINNT=0x0501 -c src\\clean.cc -o build\\clean.o",+    "file": "src\\clean.cc"+  }+]
+ src/Test/Ninja/continuations.ninja view
@@ -0,0 +1,12 @@++rule $+    run+    command $+    = $+    touch $+    $out++build $+    continuations.txt $+    : $+    run
+ src/Test/Ninja/lexical.ninja view
@@ -0,0 +1,7 @@++rule test.run+    command = echo ${foo.bar}$foo.bar > $out++build lexical.txt: test.run+    foo.bar = XFoo_BarX+    foo = XFooX
+ src/Test/Ninja/lint.ninja view
@@ -0,0 +1,19 @@++rule gen+    command = echo $out > $out++rule run+    command = (echo $out : $out.gen > $out.d) && (echo $out > $out)+    depfile = $out.d++build good: phony good1 good2++build good1: run || good1.gen+build good1.gen: gen++build good2: run || good2_phony+build good2_phony: phony good2.gen+build good2.gen: gen++build bad: run | input+build bad.gen: gen
+ src/Test/Ninja/nocreate.ninja view
@@ -0,0 +1,5 @@++rule gen+    command = echo x >> nocreate.log++build nocreate.out: gen nocreate.in
+ src/Test/Ninja/outputtouch.ninja view
@@ -0,0 +1,5 @@++rule record+    command = echo hello > $out++build outputtouch.txt: record
+ src/Test/Ninja/phonyorder.ninja view
@@ -0,0 +1,13 @@++rule create+  command = touch $out++rule copy+  command = cp $from $out++build Foo2: phony || foo.txt++build bar.txt: copy || Foo2+  from = foo.txt++build foo.txt: create
+ src/Test/Ninja/redefine.ninja view
@@ -0,0 +1,13 @@++vGlobal = version1++rule record+    # should produce version3 version2+    command = echo $vGlobal $vBuild > $out++vGlobal = version2++build redefine.txt: record+    vBuild = $vGlobal++vGlobal = version3
+ src/Test/Ninja/restart.ninja view
@@ -0,0 +1,8 @@++rule add+    command = echo build restart.txt: self >> $out++build restart.ninja: add++rule self+    command = echo $out > $out
+ src/Test/Ninja/subdir/1.ninja view
@@ -0,0 +1,2 @@+# weirdly, Ninja includes are not relative to who includes them+include subdir/2.ninja
+ src/Test/Ninja/subdir/2.ninja view
+ src/Test/Ninja/test1.ninja view
@@ -0,0 +1,5 @@++rule run+    command = touch $out++build out1.txt: run
+ src/Test/Ninja/test2.ninja view
@@ -0,0 +1,8 @@++rule run+    command = touch $out++build out2.1: run+build out2.2: run++default out2.2
+ src/Test/Ninja/test3-inc.ninja view
@@ -0,0 +1,3 @@+v5 = i1++build out3.3: dump
+ src/Test/Ninja/test3-sub.ninja view
@@ -0,0 +1,6 @@+v4 = s1+v5 = s1++build out3.4: dump++v5 = s2
+ src/Test/Ninja/test3.ninja view
@@ -0,0 +1,24 @@+++v1 = g1+v5 = g1++rule dump+    command = echo $v1+$v2+$v3+$v4+$v5 > $out++v1 = g2++build out3.1: dump+    v2 = b1++v1 = g3++subninja test3-sub.ninja++include test3-inc.ninja++build out3.2: dump++v1 = g4++include subdir/1.ninja
+ src/Test/Ninja/test4.ninja view
@@ -0,0 +1,9 @@++rule run+    command = touch $out++build ./out.txt: run++build dir/../out2.txt: run++build out: phony ./out.txt out2.txt
+ src/Test/Ninja/test5.ninja view
@@ -0,0 +1,5 @@++rule run+    command = touch $out++build output$ file: run
+ src/Test/Ninja/test6-inc.ninja view
@@ -0,0 +1,1 @@+v2 = g2
+ src/Test/Ninja/test6-sub.ninja view
@@ -0,0 +1,1 @@+v2 = g3
+ src/Test/Ninja/test6.ninja view
@@ -0,0 +1,3 @@+v2 = g1+include ${v1}-inc.ninja+subninja ${v1}-sub.ninja
+ src/Test/Ninja/test7.ninja view
@@ -0,0 +1,7 @@+# #565, check multi-file rules that don't create their contents+ninja_required_version = 1.5+build test : phony a b+rule CUSTOM_COMMAND+   command = $COMMAND+build a b : CUSTOM_COMMAND+  COMMAND = cd
+ src/Test/Oracle.hs view
@@ -0,0 +1,118 @@+{-# LANGUAGE TypeFamilies, ConstraintKinds, ScopedTypeVariables #-}+{-# LANGUAGE DeriveDataTypeable, TypeOperators, GeneralizedNewtypeDeriving #-}+{-# OPTIONS_GHC -Wno-orphans #-}++module Test.Oracle(main) where++import Development.Shake+import Development.Shake.Classes+import Development.Shake.FilePath+import General.GetOpt+import Data.List.Extra+import Data.Tuple.Extra+import Test.Type hiding (RandomType)+import qualified Test.Type as T+import Control.Monad+import General.Extra+++-- These are instances we'll compute over+type instance RuleResult String = String+type instance RuleResult Int = String+type instance RuleResult () = String++type instance RuleResult Bool = Bool -- test results don't have to be a boolean++newtype FileLen = FileLen FilePath+    deriving (Eq,Show,NFData,Typeable,Hashable,Binary)+type instance RuleResult FileLen = Int++newtype RandomType = RandomType (BinarySentinel String)+    deriving (Eq,Show,NFData,Typeable,Hashable,Binary)++type instance RuleResult RandomType = Int+type instance RuleResult T.RandomType = Int++data Define = Define String String -- this type produces this result+opt = [Option "" ["def"] (ReqArg (Right . uncurry Define . second tailErr . breakOn "=") "type=value") ""]++main = testBuildArgs test opt $ \args -> do+    addOracle $ \(T.RandomType _) -> pure 42+    addOracle $ \(RandomType _) -> pure (-42)+    "randomtype.txt" %> \out -> do+        a <- askOracle $ T.RandomType $ BinarySentinel ()+        b <- askOracle $ RandomType $ BinarySentinel ()+        writeFile' out $ show (a,b)++    addOracle $ \b -> pure $ not b+    "true.txt" %> \out -> writeFile' out . show =<< askOracle False++    let add :: forall a . (ShakeValue a, RuleResult a ~ String) => String -> a -> Rules ()+        add name key = do+            name <.> "txt" %> \out -> do+                liftIO $ appendFile ".log" "."+                writeFile' out =<< askOracle key+            forM_ [val | Define nam val <- args, nam == name] $ \val ->+                addOracle $ \(_ :: a) -> pure val+    add "string" ""+    add "unit" ()+    add "int" (0 :: Int)++    addOracleCache $ \(FileLen file) -> do+        liftIO $ appendFile ".log" "#"+        length <$> readFile' file+    "cache_out.txt" %> \out -> do+        o <- askOracle (FileLen "cache_in.txt")+        liftIO $ appendFile ".log" "!"+        writeFile' out $ show o++test build = do+    build ["clean"]++    build ["randomtype.txt"]+    assertContents "randomtype.txt" "(42,-42)"++    -- check it rebuilds when it should+    writeFile ".log" ""+    build ["--def=string=name","string.txt"]+    assertContents "string.txt" "name"+    build ["--def=string=name","string.txt"]+    assertContents "string.txt" "name"+    build ["--def=string=test","string.txt"]+    assertContents "string.txt" "test"+    assertContents ".log" ".."++    -- check adding/removing redundant oracles does not trigger a rebuild+    build ["--def=string=test","string.txt","--def=unit=bob"]+    build ["--def=string=test","string.txt","--def=int=fred"]+    build ["--def=string=test","string.txt"]+    assertContents "string.txt" "test"+    assertContents ".log" ".."++    writeFile ".log" ""+    writeFile "cache_in.txt" "aaa"+    build ["cache_out.txt","--sleep"]+    assertContents "cache_out.txt" "3"+    assertContents ".log" "#!"+    writeFile "cache_in.txt" "zzz"+    build ["cache_out.txt","--sleep"]+    build ["cache_out.txt","--sleep"]+    assertContents "cache_out.txt" "3"+    assertContents ".log" "#!#"+    writeFile "cache_in.txt" "zzzz"+    build ["cache_out.txt","--sleep"]+    assertContents "cache_out.txt" "4"+    assertContents ".log" "#!##!"++    -- check error messages are good+    let errors args err = assertExceptionAfter (replace "\\" "/") err $ build $ "--quiet" : args++    build ["--def=unit=test","unit.txt"]+    errors ["unit.txt"] -- Building with an an Oracle that has been removed+        ["missing a call to addOracle"]++    errors ["int.txt"] -- Building with an Oracle that I know nothing about+        ["missing a call to addOracle"]++    errors ["--def=string=1","--def=string=1"] -- Two Oracles defined in one go+        ["oracle defined twice", "Test/Oracle.hs"]
+ src/Test/OrderOnly.hs view
@@ -0,0 +1,60 @@++module Test.OrderOnly(main) where++import Development.Shake+import Test.Type+import System.Directory(removeFile)+import Control.Exception.Extra+++main = testBuild test $ do+    "bar.txt" %> \out -> do+        alwaysRerun+        writeFile' out =<< liftIO (readFile "bar.in")++    "foo.txt" %> \out -> do+        let src = "bar.txt"+        orderOnly [src]+        writeFile' out =<< liftIO (readFile src)+        need [src]++    "baz.txt" %> \out -> do+        let src = "bar.txt"+        orderOnly [src]+        liftIO $ appendFile out "x"++    "primary.txt" %> \out -> do+        need ["source.txt"]+        orderOnly ["intermediate.txt"]+        writeFile' out =<< liftIO (readFile "intermediate.txt")++    "intermediate.txt" %> \out ->+        copyFile' "source.txt" out+++test build = do+    writeFile "bar.in" "in"+    build ["foo.txt","--sleep"]+    assertContents "foo.txt" "in"+    writeFile "bar.in" "out"+    build ["foo.txt","--sleep"]+    assertContents "foo.txt" "out"++    writeFile "baz.txt" ""+    writeFile "bar.in" "in"+    build ["baz.txt","--sleep"]+    assertContents "baz.txt" "x"+    writeFile "bar.in" "out"+    build ["baz.txt"]+    assertContents "baz.txt" "x"++    ignore $ removeFile "intermediate.txt"+    writeFile "source.txt" "x"+    build ["primary.txt","--sleep"]+    assertContents "intermediate.txt" "x"+    removeFile "intermediate.txt"+    build ["primary.txt","--sleep"]+    assertMissing "intermediate.txt"+    writeFile "source.txt" "y"+    build ["primary.txt","--sleep"]+    assertContents "intermediate.txt" "y"
+ src/Test/Parallel.hs view
@@ -0,0 +1,116 @@++module Test.Parallel(main) where++import Development.Shake+import Test.Type+import Data.Foldable+import Data.Tuple.Extra+import Control.Monad+import Control.Concurrent.Extra+import Data.IORef+++main = testBuild test $ do+    "AB.txt" %> \out -> do+        -- need [obj "A.txt", obj "B.txt"]+        (text1,text2) <- readFile' "A.txt" `par` readFile' "B.txt"+        writeFile' out $ text1 ++ text2+++    sem <- liftIO $ newQSemN 0+    "papplicative_*" %> \out -> do+        -- wait for both to do the initial start before continuing+        liftIO $ assertWithin 1 $ do+            signalQSemN sem 1+            waitQSemN sem 3+            signalQSemN sem 3+        writeFile' out ""++    phony "papplicative" $ do+        need ["papplicative_1"]+        need ["papplicative_2"]+        let ensureReturn = pure ()+        ensureReturn -- should work even though we have a pure+        need ["papplicative_3"]++    "pseparate_*" %> \out -> do+        liftIO $ appendFile "pseparate.log" "["+        liftIO $ sleep 0.1+        liftIO $ appendFile "pseparate.log" "]"+        writeFile' out ""++    phony "pseparate" $ do+        need ["pseparate_1"]+        liftIO $ pure ()+        need ["pseparate_2"]++    sem <- liftIO $ newQSemN 0+    "ptraverse_*" %> \out -> do+        -- wait for all to do the initial start before continuing+        liftIO $ assertWithin 1 $ do+            signalQSemN sem 1+            waitQSemN sem 8+            signalQSemN sem 8+        writeFile' out ""++    phony "ptraverse" $+        traverse_ (need . pure) ["ptraverse_" ++ show i | i <- [1..8]]++    phony "cancel" $ do+        writeFile' "cancel" ""+        done <- liftIO $ newIORef 0+        lock <- liftIO newLock+        void $ parallel $ replicate 5 $ liftIO $ do+            x <- atomicModifyIORef done $ dupe . succ+            when (x == 3) $ do sleep 0.1; fail "boom"+            withLock lock $ appendFile "cancel" "x"++    phony "parallel" $ do+        active <- liftIO $ newIORef 0+        peak <- liftIO $ newIORef 0+        void $ parallel $ replicate 8 $ liftIO $ do+            now <- atomicModifyIORef active $ dupe . succ+            atomicModifyIORef peak $ dupe . max now+            sleep 0.1+            atomicModifyIORef active $ dupe . pred+        peak <- liftIO $ readIORef peak+        writeFile' "parallel" $ show peak++    "parallels" %> \out -> do+        xs <- parallel $ replicate 5 $ parallel $ map pure [1..5]+        writeFile' out $ show xs++    phony "timings" $+        void $ parallel $ map (liftIO . sleep) [1, 2, 0, 1]+++test build = do+    build ["clean"]+    writeFile "A.txt" "AAA"+    writeFile "B.txt" "BBB"+    build ["AB.txt","--sleep"]+    assertContents "AB.txt" "AAABBB"+    appendFile "A.txt" "aaa"+    build ["AB.txt"]+    assertContents "AB.txt" "AAAaaaBBB"++    assertException ["boom"] $ build ["cancel","-j1","--quiet"]+    assertContents "cancel" "xx"+    build ["parallel","-j1"]+    assertContents "parallel" "1"+    build ["parallel","-j5"]+    assertContents "parallel" "5"++    build ["parallels"]+    assertContents "parallels" $ show $ replicate 5 [1..5]++    writeFile "pseparate.log" ""+    build ["pseparate","-j2"]+    assertContents "pseparate.log" "[][]"+    build ["papplicative","-j3"]+    build ["ptraverse","-j8"]++    build ["timings","-j6"]+    assertTimings build [("timings",4)]+    build ["timings","-j1"]+    assertTimings build [("timings",4)]
+ src/Test/Pool.hs view
@@ -0,0 +1,105 @@++module Test.Pool(main) where++import Test.Type+import General.Pool++import Control.Concurrent.Extra+import Control.Exception.Extra+import Control.Monad+import System.Time.Extra+import Data.Either.Extra+import General.Timing+++main = testSimple $ do+    -- See #474, we should never be running pool actions masked+    let add pool act = addPool PoolStart pool $ do+            Unmasked <- getMaskingState+            act++    forM_ [False,True] $ \deterministic -> do+        -- check that it aims for exactly the limit+        forM_ [1..6] $ \n -> do+            var <- newVar (0,0) -- (maximum, current)+            runPool deterministic n $ \pool ->+                replicateM_ 5 $+                    add pool $ do+                        modifyVar_ var $ \(mx,now) -> pure (max (now+1) mx, now+1)+                        -- requires that all tasks get spawned within 0.1s+                        sleep 0.1+                        modifyVar_ var $ \(mx,now) -> pure (mx,now-1)+            res <- readVar var+            res === (min n 5, 0)++        -- check that exceptions are immediate+        good <- newVar True+        started <- newBarrier+        stopped <- newBarrier+        res <- try_ $ runPool deterministic 3 $ \pool -> do+                add pool $ do+                    waitBarrier started+                    throwIO Underflow+                add pool $+                    flip finally (signalBarrier stopped ()) $ do+                        signalBarrier started ()+                        sleep 10+                        modifyVar_ good $ const $ pure False+        -- note that the pool finishing means we started killing our threads+        -- not that they have actually died+        mapLeft fromException res === Left (Just Underflow)+        waitBarrier stopped+        assertBoolIO (readVar good) "Must be true"++        -- check someone spawned when at zero todo still gets run+        done <- newBarrier+        runPool deterministic 1 $ \pool ->+            add pool $+                add pool $+                    signalBarrier done ()+        assertWithin 1 $ waitBarrier done++        -- check high priority stuff runs first+        res <- newVar ""+        runPool deterministic 1 $ \pool -> do+            let note c = modifyVar_ res $ pure . (c:)+            -- deliberately in a random order+            addPool PoolBatch pool $ note 'b'+            addPool PoolException pool $ note 'e'+            addPool PoolStart pool $ note 's'+            addPool PoolStart pool $ note 's'+            addPool PoolResume pool $ note 'r'+            addPool PoolException pool $ note 'e'+        (=== "bssree") =<< readVar res++        -- check that killing a thread pool stops the tasks, bug 545+        -- and propagates the right exception+        thread <- newBarrier+        died <- newBarrier+        done <- newBarrier+        t <- flip forkFinally (signalBarrier died) $ runPool deterministic 1 $ \pool ->+            add pool $+                flip onException (signalBarrier done ()) $ do+                    flip throwTo Overflow =<< waitBarrier thread+                    sleep 10+        signalBarrier thread t+        assertWithin 1 $ waitBarrier done+        res <- assertWithin 1 $ waitBarrier died+        mapLeft fromException res === Left (Just Overflow)++        -- check that killing a thread pool aborts all threads before it returns+        started <- newBarrier+        var <- newVar False+        try_ $ runPool deterministic 2 $ \pool -> do+            add pool $ try_ $ (do signalBarrier started (); sleep 10) `finally` (do sleep 1; writeVar var True)+            add pool $ do waitBarrier started; throw Overflow+        (=== True) =<< readVar var++    -- benchmark for testing thread performance, see https://github.com/ndmitchell/shake/pull/751+    when False $ do+        resetTimings+        withNumCapabilities 4 $ do+            (d, _) <- duration $ runPool False 4 $ \pool ->+                replicateM_ 200000 $ addPool PoolStart pool $ pure ()+            print d+            print =<< getTimings
+ src/Test/Progress.hs view
@@ -0,0 +1,62 @@+module Test.Progress(main) where++import Development.Shake.Internal.Progress+import Development.Shake.Internal.Options+import Test.Type+import System.Directory.Extra+import System.FilePath+import General.Extra+++main = testBuild test $ pure ()+++-- | Given a list of todo times, get out a list of how long is predicted+prog = progEx 10000000000000000+++progEx :: Double -> [Double] -> IO [Double]+progEx mxDone todo = do+    let resolution = 10000 -- Use resolution to get extra detail on the numbers+    let done = scanl (+) 0 $ map (min mxDone . max 0) $ zipWith (-) todo (tailErr todo)+    let res = progressReplay $ zip (map (*resolution) [1..]) $ tailErr $ zipWith (\t d -> mempty{timeBuilt=d*resolution,timeTodo=(t*resolution,0)}) todo done+    pure $ (0/0) : map ((/ resolution) . actualSecs) res+++test build = do+    -- perfect functions should match perfectly+    xs <- prog [10,9..1]+    drop 2 xs === [8,7..1]+    xs <- prog $ map (*5) [10,9..1]+    drop 2 xs === [8,7..1]+    xs <- prog $ map (*0.2) [10,9..1]+    let dp3 x = fromIntegral (round $ x * 1000 :: Int) / 1000+    map dp3 (drop 2 xs) === [8,7..1]++    -- The properties below this line could be weakened++    -- increasing functions can't match+    xs <- prog [5,6,7]+    last xs === 7++    -- the first value must be plausible, or missing+    xs <- prog [187]+    assertBool (isNaN $ headErr xs) "No first value"++    -- desirable properties, could be weakened+    xs <- progEx 2 $ 100:map (*2) [10,9..1]+    drop 5 xs === [6,5..1]+    xs <- progEx 1 [10,9,100,8,7,6,5,4,3,2,1]+    assertBool (all ((<= 1.5) . abs) $ zipWith (-) (drop 5 xs) [6,5..1]) "Close"++    -- if no progress is made, don't keep the time going up+    xs <- prog [10,9,8,7,7,7,7,7]+    drop 5 xs === [7,7,7]++    -- if the work rate changes, should somewhat reflect that+    xs <- prog [10,9,8,7,6.5,6,5.5,5]+    assertBool (last xs > 7.1) "Some discounting (factor=0 would give 7)"++    xs <- listFiles $ shakeRoot </> "src/Test/Progress"+    build $ ["--progress=replay=" ++ x | x <- xs, takeExtension x == ".prog"] +++            ["--no-report","--report=-","--report=" ++ "progress.html"]
+ src/Test/Progress/progress-nan.prog view
@@ -0,0 +1,3 @@+(5.215521335601807,Progress {isFailure = Nothing, countSkipped = 5028, countBuilt = 0, countUnknown = 36224, countTodo = 1837, timeSkipped = 274149.05088049243, timeBuilt = 0.0, timeUnknown = 31144.710513075814, timeTodo = (4301.8477063977625,1)})+(12.997299194335938,Progress {isFailure = Nothing, countSkipped = 12154, countBuilt = 0, countUnknown = 23682, countTodo = 7253, timeSkipped = 274894.82577174786, timeBuilt = 0.0, timeUnknown = 23933.863898285897, timeTodo = (10766.919429932255,1)})+(18.471847534179688,Progress {isFailure = Nothing, countSkipped = 18273, countBuilt = 27, countUnknown = 13862, countTodo = 10931, timeSkipped = 275406.36595057615, timeBuilt = 1.7951794527471066, timeUnknown = 17710.551982904668, timeTodo = (16478.41014388157,4)})
+ src/Test/Progress/self-clean-j2.prog view
@@ -0,0 +1,62 @@+(1.120224,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 254, countUnknown = 0, countTodo = 145, timeSkipped = 0.0, timeBuilt = 0.8861771221272647, timeUnknown = 0.0, timeTodo = (0.0,145)})+(2.4994998,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 258, countUnknown = 0, countTodo = 147, timeSkipped = 0.0, timeBuilt = 1.259251721901819, timeUnknown = 0.0, timeTodo = (0.0,147)})+(5.156031,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 259, countUnknown = 0, countTodo = 146, timeSkipped = 0.0, timeBuilt = 3.8557707152795047, timeUnknown = 0.0, timeTodo = (0.0,146)})+(6.4472423,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 261, countUnknown = 0, countTodo = 144, timeSkipped = 0.0, timeBuilt = 6.519303449196741, timeUnknown = 0.0, timeTodo = (0.0,144)})+(7.737371,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 262, countUnknown = 0, countTodo = 143, timeSkipped = 0.0, timeBuilt = 9.126777537865564, timeUnknown = 0.0, timeTodo = (0.0,143)})+(9.061503,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 267, countUnknown = 0, countTodo = 138, timeSkipped = 0.0, timeBuilt = 11.739121564431116, timeUnknown = 0.0, timeTodo = (0.0,138)})+(10.368634,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 268, countUnknown = 0, countTodo = 137, timeSkipped = 0.0, timeBuilt = 14.354383119149134, timeUnknown = 0.0, timeTodo = (0.0,137)})+(11.658763,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 272, countUnknown = 0, countTodo = 133, timeSkipped = 0.0, timeBuilt = 16.976646550698206, timeUnknown = 0.0, timeTodo = (0.0,133)})+(12.941892,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 274, countUnknown = 0, countTodo = 131, timeSkipped = 0.0, timeBuilt = 19.57990659098141, timeUnknown = 0.0, timeTodo = (0.0,131)})+(14.22602,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 279, countUnknown = 0, countTodo = 126, timeSkipped = 0.0, timeBuilt = 22.17116750101559, timeUnknown = 0.0, timeTodo = (0.0,126)})+(15.511148,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 282, countUnknown = 0, countTodo = 123, timeSkipped = 0.0, timeBuilt = 24.74242699961178, timeUnknown = 0.0, timeTodo = (0.0,123)})+(16.794277,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 283, countUnknown = 0, countTodo = 122, timeSkipped = 0.0, timeBuilt = 27.31368459085934, timeUnknown = 0.0, timeTodo = (0.0,122)})+(18.085405,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 288, countUnknown = 0, countTodo = 117, timeSkipped = 0.0, timeBuilt = 29.8999453864526, timeUnknown = 0.0, timeTodo = (0.0,117)})+(19.398537,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 294, countUnknown = 0, countTodo = 111, timeSkipped = 0.0, timeBuilt = 32.487208493752405, timeUnknown = 0.0, timeTodo = (0.0,111)})+(21.451742,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 295, countUnknown = 0, countTodo = 110, timeSkipped = 0.0, timeBuilt = 35.872547277016565, timeUnknown = 0.0, timeTodo = (0.0,110)})+(22.761873,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 297, countUnknown = 0, countTodo = 108, timeSkipped = 0.0, timeBuilt = 39.24288571695797, timeUnknown = 0.0, timeTodo = (0.0,108)})+(24.060003,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 298, countUnknown = 0, countTodo = 107, timeSkipped = 0.0, timeBuilt = 41.825143941445276, timeUnknown = 0.0, timeTodo = (0.0,107)})+(25.555153,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 304, countUnknown = 0, countTodo = 101, timeSkipped = 0.0, timeBuilt = 44.66642964701168, timeUnknown = 0.0, timeTodo = (0.0,101)})+(26.868284,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 305, countUnknown = 0, countTodo = 100, timeSkipped = 0.0, timeBuilt = 47.460708745522425, timeUnknown = 0.0, timeTodo = (0.0,100)})+(28.22642,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 306, countUnknown = 0, countTodo = 99, timeSkipped = 0.0, timeBuilt = 50.111974843544886, timeUnknown = 0.0, timeTodo = (0.0,99)})+(29.52355,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 308, countUnknown = 0, countTodo = 97, timeSkipped = 0.0, timeBuilt = 52.788244374794886, timeUnknown = 0.0, timeTodo = (0.0,97)})+(30.82868,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 309, countUnknown = 0, countTodo = 96, timeSkipped = 0.0, timeBuilt = 55.38850606302731, timeUnknown = 0.0, timeTodo = (0.0,96)})+(31.83378,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 309, countUnknown = 0, countTodo = 96, timeSkipped = 0.0, timeBuilt = 55.38850606302731, timeUnknown = 0.0, timeTodo = (0.0,96)})+(33.099907,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 311, countUnknown = 0, countTodo = 94, timeSkipped = 0.0, timeBuilt = 57.70873845438473, timeUnknown = 0.0, timeTodo = (0.0,94)})+(34.455044,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 312, countUnknown = 0, countTodo = 93, timeSkipped = 0.0, timeBuilt = 62.583227284951136, timeUnknown = 0.0, timeTodo = (0.0,93)})+(35.775173,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 323, countUnknown = 0, countTodo = 82, timeSkipped = 0.0, timeBuilt = 65.22149098734371, timeUnknown = 0.0, timeTodo = (0.0,82)})+(37.087307,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 324, countUnknown = 0, countTodo = 81, timeSkipped = 0.0, timeBuilt = 67.89576161722653, timeUnknown = 0.0, timeTodo = (0.0,81)})+(38.39644,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 332, countUnknown = 0, countTodo = 73, timeSkipped = 0.0, timeBuilt = 70.54603017191403, timeUnknown = 0.0, timeTodo = (0.0,73)})+(39.705566,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 336, countUnknown = 0, countTodo = 69, timeSkipped = 0.0, timeBuilt = 73.18129933695309, timeUnknown = 0.0, timeTodo = (0.0,69)})+(41.676765,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 339, countUnknown = 0, countTodo = 66, timeSkipped = 0.0, timeBuilt = 76.48663152079098, timeUnknown = 0.0, timeTodo = (0.0,66)})+(42.969894,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 342, countUnknown = 0, countTodo = 63, timeSkipped = 0.0, timeBuilt = 79.77195943216793, timeUnknown = 0.0, timeTodo = (0.0,63)})+(44.364033,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 345, countUnknown = 0, countTodo = 60, timeSkipped = 0.0, timeBuilt = 82.46222890238278, timeUnknown = 0.0, timeTodo = (0.0,60)})+(45.367134,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 348, countUnknown = 0, countTodo = 57, timeSkipped = 0.0, timeBuilt = 85.15849507669918, timeUnknown = 0.0, timeTodo = (0.0,57)})+(47.0483,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 351, countUnknown = 0, countTodo = 54, timeSkipped = 0.0, timeBuilt = 87.8587666831445, timeUnknown = 0.0, timeTodo = (0.0,54)})+(48.052402,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 351, countUnknown = 0, countTodo = 54, timeSkipped = 0.0, timeBuilt = 87.8587666831445, timeUnknown = 0.0, timeTodo = (0.0,54)})+(49.890587,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 354, countUnknown = 0, countTodo = 51, timeSkipped = 0.0, timeBuilt = 90.69304478983395, timeUnknown = 0.0, timeTodo = (0.0,51)})+(50.894688,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 354, countUnknown = 0, countTodo = 51, timeSkipped = 0.0, timeBuilt = 90.69304478983395, timeUnknown = 0.0, timeTodo = (0.0,51)})+(51.897785,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 354, countUnknown = 0, countTodo = 51, timeSkipped = 0.0, timeBuilt = 90.69304478983395, timeUnknown = 0.0, timeTodo = (0.0,51)})+(54.92909,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 357, countUnknown = 0, countTodo = 48, timeSkipped = 0.0, timeBuilt = 94.47342885355465, timeUnknown = 0.0, timeTodo = (0.0,48)})+(56.23222,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 358, countUnknown = 0, countTodo = 47, timeSkipped = 0.0, timeBuilt = 97.04368794779293, timeUnknown = 0.0, timeTodo = (0.0,47)})+(57.53035,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 360, countUnknown = 0, countTodo = 45, timeSkipped = 0.0, timeBuilt = 100.92107594828121, timeUnknown = 0.0, timeTodo = (0.0,45)})+(58.82748,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 361, countUnknown = 0, countTodo = 44, timeSkipped = 0.0, timeBuilt = 103.52433598856442, timeUnknown = 0.0, timeTodo = (0.0,44)})+(60.104607,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 368, countUnknown = 0, countTodo = 37, timeSkipped = 0.0, timeBuilt = 106.14560521463864, timeUnknown = 0.0, timeTodo = (0.0,37)})+(62.0268,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 369, countUnknown = 0, countTodo = 36, timeSkipped = 0.0, timeBuilt = 109.38093007425778, timeUnknown = 0.0, timeTodo = (0.0,36)})+(63.33293,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 372, countUnknown = 0, countTodo = 33, timeSkipped = 0.0, timeBuilt = 112.58624852518551, timeUnknown = 0.0, timeTodo = (0.0,33)})+(64.62606,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 374, countUnknown = 0, countTodo = 31, timeSkipped = 0.0, timeBuilt = 115.16150487284176, timeUnknown = 0.0, timeTodo = (0.0,31)})+(65.925186,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 379, countUnknown = 0, countTodo = 26, timeSkipped = 0.0, timeBuilt = 117.77476704935543, timeUnknown = 0.0, timeTodo = (0.0,26)})+(68.11641,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 387, countUnknown = 0, countTodo = 18, timeSkipped = 0.0, timeBuilt = 122.62825597147457, timeUnknown = 0.0, timeTodo = (0.0,18)})+(69.121506,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 387, countUnknown = 0, countTodo = 18, timeSkipped = 0.0, timeBuilt = 122.62825597147457, timeUnknown = 0.0, timeTodo = (0.0,18)})+(70.77867,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 390, countUnknown = 0, countTodo = 15, timeSkipped = 0.0, timeBuilt = 125.30251897196285, timeUnknown = 0.0, timeTodo = (0.0,15)})+(74.353035,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 393, countUnknown = 0, countTodo = 12, timeSkipped = 0.0, timeBuilt = 127.54874242166989, timeUnknown = 0.0, timeTodo = (0.0,12)})+(75.35613,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 396, countUnknown = 0, countTodo = 9, timeSkipped = 0.0, timeBuilt = 130.15401280741207, timeUnknown = 0.0, timeTodo = (0.0,9)})+(76.85028,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 399, countUnknown = 0, countTodo = 6, timeSkipped = 0.0, timeBuilt = 133.99539006571285, timeUnknown = 0.0, timeTodo = (0.0,6)})+(79.081505,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 402, countUnknown = 0, countTodo = 3, timeSkipped = 0.0, timeBuilt = 136.22862065653317, timeUnknown = 0.0, timeTodo = (0.0,3)})+(81.25272,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 404, countUnknown = 0, countTodo = 1, timeSkipped = 0.0, timeBuilt = 138.41584599833004, timeUnknown = 0.0, timeTodo = (0.0,1)})+(82.260826,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 404, countUnknown = 0, countTodo = 1, timeSkipped = 0.0, timeBuilt = 138.41584599833004, timeUnknown = 0.0, timeTodo = (0.0,1)})+(83.26492,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 404, countUnknown = 0, countTodo = 1, timeSkipped = 0.0, timeBuilt = 138.41584599833004, timeUnknown = 0.0, timeTodo = (0.0,1)})+(84.27003,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 404, countUnknown = 0, countTodo = 1, timeSkipped = 0.0, timeBuilt = 138.41584599833004, timeUnknown = 0.0, timeTodo = (0.0,1)})+(85.274124,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 404, countUnknown = 0, countTodo = 1, timeSkipped = 0.0, timeBuilt = 138.41584599833004, timeUnknown = 0.0, timeTodo = (0.0,1)})+(86.28023,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 404, countUnknown = 0, countTodo = 1, timeSkipped = 0.0, timeBuilt = 138.41584599833004, timeUnknown = 0.0, timeTodo = (0.0,1)})+(87.284325,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 404, countUnknown = 0, countTodo = 1, timeSkipped = 0.0, timeBuilt = 138.41584599833004, timeUnknown = 0.0, timeTodo = (0.0,1)})+(88.28843,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 404, countUnknown = 0, countTodo = 1, timeSkipped = 0.0, timeBuilt = 138.41584599833004, timeUnknown = 0.0, timeTodo = (0.0,1)})
+ src/Test/Progress/self-rebuild-j2.prog view
@@ -0,0 +1,56 @@+(3.6053605,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 258, countUnknown = 1, countTodo = 147, timeSkipped = 0.0, timeBuilt = 1.054105345858261, timeUnknown = 0.0, timeTodo = (135.01951599121094,0)})+(4.8964896,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 259, countUnknown = 1, countTodo = 146, timeSkipped = 0.0, timeBuilt = 3.6373634978663176, timeUnknown = 0.0, timeTodo = (132.3802523612976,0)})+(6.189619,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 260, countUnknown = 1, countTodo = 145, timeSkipped = 0.0, timeBuilt = 6.2686262771021575, timeUnknown = 0.0, timeTodo = (129.85099935531616,0)})+(7.4677467,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 262, countUnknown = 1, countTodo = 143, timeSkipped = 0.0, timeBuilt = 8.854884450091049, timeUnknown = 0.0, timeTodo = (127.25373983383179,0)})+(8.742874,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 268, countUnknown = 1, countTodo = 137, timeSkipped = 0.0, timeBuilt = 11.444143597735092, timeUnknown = 0.0, timeTodo = (124.70048475265503,0)})+(10.016002,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 271, countUnknown = 1, countTodo = 134, timeSkipped = 0.0, timeBuilt = 16.5466540500056, timeUnknown = 0.0, timeTodo = (119.64597797393799,0)})+(11.30813,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 271, countUnknown = 1, countTodo = 134, timeSkipped = 0.0, timeBuilt = 16.5466540500056, timeUnknown = 0.0, timeTodo = (119.64597797393799,0)})+(12.59526,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 276, countUnknown = 1, countTodo = 129, timeSkipped = 0.0, timeBuilt = 19.123910252703354, timeUnknown = 0.0, timeTodo = (117.0657205581665,0)})+(13.876388,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 278, countUnknown = 1, countTodo = 127, timeSkipped = 0.0, timeBuilt = 21.708168332232162, timeUnknown = 0.0, timeTodo = (114.43845868110657,0)})+(15.173517,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 280, countUnknown = 1, countTodo = 125, timeSkipped = 0.0, timeBuilt = 24.27642471040599, timeUnknown = 0.0, timeTodo = (111.89620327949524,0)})+(16.456646,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 282, countUnknown = 1, countTodo = 123, timeSkipped = 0.0, timeBuilt = 26.85868198121898, timeUnknown = 0.0, timeTodo = (109.3659496307373,0)})+(17.726772,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 284, countUnknown = 1, countTodo = 121, timeSkipped = 0.0, timeBuilt = 29.442940060747787, timeUnknown = 0.0, timeTodo = (106.83069705963135,0)})+(19.027903,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 288, countUnknown = 1, countTodo = 117, timeSkipped = 0.0, timeBuilt = 32.00519592012279, timeUnknown = 0.0, timeTodo = (104.28944301605225,0)})+(20.345034,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 292, countUnknown = 1, countTodo = 113, timeSkipped = 0.0, timeBuilt = 34.586452786577865, timeUnknown = 0.0, timeTodo = (101.74619007110596,0)})+(21.648165,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 300, countUnknown = 1, countTodo = 105, timeSkipped = 0.0, timeBuilt = 37.32872611726634, timeUnknown = 0.0, timeTodo = (99.18993377685547,0)})+(23.717371,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 301, countUnknown = 1, countTodo = 104, timeSkipped = 0.0, timeBuilt = 40.75507003511302, timeUnknown = 0.0, timeTodo = (96.41965675354004,0)})+(25.022503,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 303, countUnknown = 1, countTodo = 102, timeSkipped = 0.0, timeBuilt = 44.12840873445384, timeUnknown = 0.0, timeTodo = (93.89340400695801,0)})+(26.289629,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 304, countUnknown = 1, countTodo = 101, timeSkipped = 0.0, timeBuilt = 46.6976664706599, timeUnknown = 0.0, timeTodo = (91.36415100097656,0)})+(27.576757,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 305, countUnknown = 1, countTodo = 100, timeSkipped = 0.0, timeBuilt = 49.27292472566478, timeUnknown = 0.0, timeTodo = (88.50186347961426,0)})+(29.49495,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 308, countUnknown = 1, countTodo = 97, timeSkipped = 0.0, timeBuilt = 52.47924644197337, timeUnknown = 0.0, timeTodo = (84.93850708007813,0)})+(31.11511,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 311, countUnknown = 1, countTodo = 94, timeSkipped = 0.0, timeBuilt = 56.04560119356029, timeUnknown = 0.0, timeTodo = (81.36915397644043,0)})+(32.42124,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 313, countUnknown = 1, countTodo = 92, timeSkipped = 0.0, timeBuilt = 58.938888852251694, timeUnknown = 0.0, timeTodo = (78.84289932250977,0)})+(33.68837,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 315, countUnknown = 1, countTodo = 90, timeSkipped = 0.0, timeBuilt = 61.51514465059154, timeUnknown = 0.0, timeTodo = (75.96561431884766,0)})+(34.961494,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 322, countUnknown = 1, countTodo = 83, timeSkipped = 0.0, timeBuilt = 64.10740501130931, timeUnknown = 0.0, timeTodo = (73.41636085510254,0)})+(36.245625,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 330, countUnknown = 1, countTodo = 75, timeSkipped = 0.0, timeBuilt = 66.67165786470287, timeUnknown = 0.0, timeTodo = (70.8551082611084,0)})+(37.545753,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 331, countUnknown = 1, countTodo = 74, timeSkipped = 0.0, timeBuilt = 69.22791320527904, timeUnknown = 0.0, timeTodo = (68.3188533782959,0)})+(38.944893,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 336, countUnknown = 1, countTodo = 69, timeSkipped = 0.0, timeBuilt = 71.91318160737865, timeUnknown = 0.0, timeTodo = (65.60857582092285,0)})+(40.345036,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 337, countUnknown = 1, countTodo = 68, timeSkipped = 0.0, timeBuilt = 74.72146255220287, timeUnknown = 0.0, timeTodo = (62.849300384521484,0)})+(41.651165,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 340, countUnknown = 1, countTodo = 65, timeSkipped = 0.0, timeBuilt = 77.43573409761302, timeUnknown = 0.0, timeTodo = (60.147029876708984,0)})+(42.9913,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 345, countUnknown = 1, countTodo = 60, timeSkipped = 0.0, timeBuilt = 80.11199981416576, timeUnknown = 0.0, timeTodo = (57.615779876708984,0)})+(44.28843,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 347, countUnknown = 1, countTodo = 58, timeSkipped = 0.0, timeBuilt = 82.76326781953685, timeUnknown = 0.0, timeTodo = (55.096527099609375,0)})+(45.844585,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 350, countUnknown = 1, countTodo = 55, timeSkipped = 0.0, timeBuilt = 85.57555038179271, timeUnknown = 0.0, timeTodo = (53.285343170166016,0)})+(46.848686,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 354, countUnknown = 1, countTodo = 51, timeSkipped = 0.0, timeBuilt = 88.44083816255443, timeUnknown = 0.0, timeTodo = (50.76008987426758,0)})+(47.852783,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 354, countUnknown = 1, countTodo = 51, timeSkipped = 0.0, timeBuilt = 88.44083816255443, timeUnknown = 0.0, timeTodo = (50.76008987426758,0)})+(50.848083,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 357, countUnknown = 1, countTodo = 48, timeSkipped = 0.0, timeBuilt = 92.16721374238841, timeUnknown = 0.0, timeTodo = (48.103824615478516,0)})+(52.852283,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 358, countUnknown = 1, countTodo = 47, timeSkipped = 0.0, timeBuilt = 95.5145495578181, timeUnknown = 0.0, timeTodo = (45.494564056396484,0)})+(54.130413,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 362, countUnknown = 1, countTodo = 43, timeSkipped = 0.0, timeBuilt = 100.13300735200755, timeUnknown = 0.0, timeTodo = (41.70818328857422,0)})+(55.41054,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 363, countUnknown = 1, countTodo = 42, timeSkipped = 0.0, timeBuilt = 102.67526275361888, timeUnknown = 0.0, timeTodo = (39.17192840576172,0)})+(56.414642,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 369, countUnknown = 1, countTodo = 36, timeSkipped = 0.0, timeBuilt = 105.25251800264232, timeUnknown = 0.0, timeTodo = (36.63368225097656,0)})+(59.073906,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 372, countUnknown = 1, countTodo = 33, timeSkipped = 0.0, timeBuilt = 107.67676574434154, timeUnknown = 0.0, timeTodo = (34.10843276977539,0)})+(60.356033,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 374, countUnknown = 1, countTodo = 31, timeSkipped = 0.0, timeBuilt = 110.21202117647044, timeUnknown = 0.0, timeTodo = (31.546173095703125,0)})+(61.641163,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 375, countUnknown = 1, countTodo = 30, timeSkipped = 0.0, timeBuilt = 114.02240401948802, timeUnknown = 0.0, timeTodo = (28.913909912109375,0)})+(62.92029,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 381, countUnknown = 1, countTodo = 24, timeSkipped = 0.0, timeBuilt = 116.60766250337474, timeUnknown = 0.0, timeTodo = (26.366653442382813,0)})+(65.09751,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 387, countUnknown = 1, countTodo = 18, timeSkipped = 0.0, timeBuilt = 121.40914184297435, timeUnknown = 0.0, timeTodo = (22.06322479248047,0)})+(66.10161,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 387, countUnknown = 1, countTodo = 18, timeSkipped = 0.0, timeBuilt = 121.40914184297435, timeUnknown = 0.0, timeTodo = (22.06322479248047,0)})+(67.678764,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 390, countUnknown = 1, countTodo = 15, timeSkipped = 0.0, timeBuilt = 123.98239928926341, timeUnknown = 0.0, timeTodo = (19.453964233398438,0)})+(71.20812,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 393, countUnknown = 1, countTodo = 12, timeSkipped = 0.0, timeBuilt = 126.19761687959544, timeUnknown = 0.0, timeTodo = (17.226730346679688,0)})+(72.21122,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 396, countUnknown = 1, countTodo = 9, timeSkipped = 0.0, timeBuilt = 128.785888974322, timeUnknown = 0.0, timeTodo = (14.163421630859375,0)})+(73.53935,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 399, countUnknown = 1, countTodo = 6, timeSkipped = 0.0, timeBuilt = 133.6913836642634, timeUnknown = 0.0, timeTodo = (11.642166137695313,0)})+(75.757576,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 402, countUnknown = 1, countTodo = 3, timeSkipped = 0.0, timeBuilt = 135.9266131564509, timeUnknown = 0.0, timeTodo = (8.530860900878906,0)})+(77.91779,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 404, countUnknown = 1, countTodo = 1, timeSkipped = 0.0, timeBuilt = 138.08883697236888, timeUnknown = 0.0, timeTodo = (6.776679992675781,0)})+(78.92289,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 404, countUnknown = 1, countTodo = 1, timeSkipped = 0.0, timeBuilt = 138.08883697236888, timeUnknown = 0.0, timeTodo = (6.776679992675781,0)})+(79.925995,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 404, countUnknown = 1, countTodo = 1, timeSkipped = 0.0, timeBuilt = 138.08883697236888, timeUnknown = 0.0, timeTodo = (6.776679992675781,0)})+(80.93109,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 404, countUnknown = 1, countTodo = 1, timeSkipped = 0.0, timeBuilt = 138.08883697236888, timeUnknown = 0.0, timeTodo = (6.776679992675781,0)})+(81.93419,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 404, countUnknown = 1, countTodo = 1, timeSkipped = 0.0, timeBuilt = 138.08883697236888, timeUnknown = 0.0, timeTodo = (6.776679992675781,0)})+(82.93929,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 404, countUnknown = 1, countTodo = 1, timeSkipped = 0.0, timeBuilt = 138.08883697236888, timeUnknown = 0.0, timeTodo = (6.776679992675781,0)})
+ src/Test/Progress/self-zero-j2.prog view
@@ -0,0 +1,57 @@+(1.020102,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 254, countUnknown = 4, countTodo = 148, timeSkipped = 0.0, timeBuilt = 0.7620761110447347, timeUnknown = 2.0004000980407e-3, timeTodo = (146.13152742385864,0)})+(3.7443745,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 258, countUnknown = 1, countTodo = 147, timeSkipped = 0.0, timeBuilt = 1.0521051175892353, timeUnknown = 0.0, timeTodo = (145.76045322418213,0)})+(5.032503,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 260, countUnknown = 1, countTodo = 145, timeSkipped = 0.0, timeBuilt = 3.678367782384157, timeUnknown = 0.0, timeTodo = (143.16193342208862,0)})+(6.339634,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 261, countUnknown = 1, countTodo = 144, timeSkipped = 0.0, timeBuilt = 6.317631412297487, timeUnknown = 0.0, timeTodo = (140.56067323684692,0)})+(7.6067605,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 262, countUnknown = 1, countTodo = 143, timeSkipped = 0.0, timeBuilt = 8.911890674382448, timeUnknown = 0.0, timeTodo = (137.99141645431519,0)})+(8.867887,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 265, countUnknown = 1, countTodo = 140, timeSkipped = 0.0, timeBuilt = 11.489148784428835, timeUnknown = 0.0, timeTodo = (135.31988191604614,0)})+(10.124012,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 266, countUnknown = 1, countTodo = 139, timeSkipped = 0.0, timeBuilt = 14.01840179041028, timeUnknown = 0.0, timeTodo = (132.74862432479858,0)})+(11.394139,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 270, countUnknown = 1, countTodo = 135, timeSkipped = 0.0, timeBuilt = 16.545654464513063, timeUnknown = 0.0, timeTodo = (130.13927960395813,0)})+(12.661266,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 278, countUnknown = 1, countTodo = 127, timeSkipped = 0.0, timeBuilt = 19.09290998056531, timeUnknown = 0.0, timeTodo = (127.51380348205566,0)})+(13.928392,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 280, countUnknown = 1, countTodo = 125, timeSkipped = 0.0, timeBuilt = 21.638164687901735, timeUnknown = 0.0, timeTodo = (124.94054412841797,0)})+(15.19352,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 283, countUnknown = 1, countTodo = 122, timeSkipped = 0.0, timeBuilt = 24.176418472081423, timeUnknown = 0.0, timeTodo = (122.32628202438354,0)})+(16.462646,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 284, countUnknown = 1, countTodo = 121, timeSkipped = 0.0, timeBuilt = 26.708671737462282, timeUnknown = 0.0, timeTodo = (119.71102046966553,0)})+(17.723772,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 286, countUnknown = 1, countTodo = 119, timeSkipped = 0.0, timeBuilt = 29.24492471292615, timeUnknown = 0.0, timeTodo = (117.13076210021973,0)})+(18.9989,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 290, countUnknown = 1, countTodo = 115, timeSkipped = 0.0, timeBuilt = 31.782178092747927, timeUnknown = 0.0, timeTodo = (114.32748413085938,0)})+(20.265026,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 294, countUnknown = 1, countTodo = 111, timeSkipped = 0.0, timeBuilt = 34.328432250767946, timeUnknown = 0.0, timeTodo = (110.95114421844482,0)})+(21.525152,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 296, countUnknown = 1, countTodo = 109, timeSkipped = 0.0, timeBuilt = 36.87168710306287, timeUnknown = 0.0, timeTodo = (108.3658857345581,0)})+(22.792278,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 297, countUnknown = 1, countTodo = 108, timeSkipped = 0.0, timeBuilt = 39.39593904092908, timeUnknown = 0.0, timeTodo = (105.79362773895264,0)})+(24.09941,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 301, countUnknown = 1, countTodo = 104, timeSkipped = 0.0, timeBuilt = 41.934190917760134, timeUnknown = 0.0, timeTodo = (103.46539211273193,0)})+(25.552555,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 307, countUnknown = 1, countTodo = 98, timeSkipped = 0.0, timeBuilt = 44.71846978738904, timeUnknown = 0.0, timeTodo = (100.06105041503906,0)})+(27.156715,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 310, countUnknown = 1, countTodo = 95, timeSkipped = 0.0, timeBuilt = 47.48474519327283, timeUnknown = 0.0, timeTodo = (97.22976875305176,0)})+(28.427843,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 311, countUnknown = 1, countTodo = 94, timeSkipped = 0.0, timeBuilt = 50.347032714635134, timeUnknown = 0.0, timeTodo = (94.5565013885498,0)})+(29.692968,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 312, countUnknown = 1, countTodo = 93, timeSkipped = 0.0, timeBuilt = 53.222318816930056, timeUnknown = 0.0, timeTodo = (91.93223762512207,0)})+(30.960096,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 314, countUnknown = 1, countTodo = 91, timeSkipped = 0.0, timeBuilt = 55.76357476785779, timeUnknown = 0.0, timeTodo = (89.2559642791748,0)})+(32.22322,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 317, countUnknown = 1, countTodo = 88, timeSkipped = 0.0, timeBuilt = 58.305828262120485, timeUnknown = 0.0, timeTodo = (86.59769439697266,0)})+(33.50235,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 321, countUnknown = 1, countTodo = 84, timeSkipped = 0.0, timeBuilt = 60.847080398350954, timeUnknown = 0.0, timeTodo = (83.98942756652832,0)})+(34.50545,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 321, countUnknown = 1, countTodo = 84, timeSkipped = 0.0, timeBuilt = 60.847080398350954, timeUnknown = 0.0, timeTodo = (83.98942756652832,0)})+(35.778576,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 327, countUnknown = 1, countTodo = 78, timeSkipped = 0.0, timeBuilt = 64.42744653299451, timeUnknown = 0.0, timeTodo = (79.1019344329834,0)})+(37.039703,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 331, countUnknown = 1, countTodo = 74, timeSkipped = 0.0, timeBuilt = 67.99280183389783, timeUnknown = 0.0, timeTodo = (75.79260063171387,0)})+(38.30183,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 332, countUnknown = 1, countTodo = 73, timeSkipped = 0.0, timeBuilt = 70.5080529935658, timeUnknown = 0.0, timeTodo = (73.16133689880371,0)})+(39.60196,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 337, countUnknown = 1, countTodo = 68, timeSkipped = 0.0, timeBuilt = 73.04030625894666, timeUnknown = 0.0, timeTodo = (70.54007148742676,0)})+(40.9971,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 341, countUnknown = 1, countTodo = 64, timeSkipped = 0.0, timeBuilt = 75.7465783841908, timeUnknown = 0.0, timeTodo = (67.84580421447754,0)})+(42.251225,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 343, countUnknown = 1, countTodo = 62, timeSkipped = 0.0, timeBuilt = 78.44684617593884, timeUnknown = 0.0, timeTodo = (64.56347465515137,0)})+(43.51035,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 348, countUnknown = 1, countTodo = 57, timeSkipped = 0.0, timeBuilt = 80.97609345987439, timeUnknown = 0.0, timeTodo = (61.85720443725586,0)})+(45.31053,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 354, countUnknown = 1, countTodo = 51, timeSkipped = 0.0, timeBuilt = 85.3115312345326, timeUnknown = 0.0, timeTodo = (56.32666015625,0)})+(46.31663,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 354, countUnknown = 1, countTodo = 51, timeSkipped = 0.0, timeBuilt = 85.3115312345326, timeUnknown = 0.0, timeTodo = (56.32666015625,0)})+(47.953796,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 357, countUnknown = 1, countTodo = 48, timeSkipped = 0.0, timeBuilt = 87.96779649332166, timeUnknown = 0.0, timeTodo = (52.5462760925293,0)})+(49.22192,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 357, countUnknown = 1, countTodo = 48, timeSkipped = 0.0, timeBuilt = 87.96779649332166, timeUnknown = 0.0, timeTodo = (52.5462760925293,0)})+(50.483047,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 358, countUnknown = 1, countTodo = 47, timeSkipped = 0.0, timeBuilt = 90.48504655435681, timeUnknown = 0.0, timeTodo = (49.943016052246094,0)})+(51.742172,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 362, countUnknown = 1, countTodo = 43, timeSkipped = 0.0, timeBuilt = 94.27242677286267, timeUnknown = 0.0, timeTodo = (46.054622650146484,0)})+(53.0143,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 364, countUnknown = 1, countTodo = 41, timeSkipped = 0.0, timeBuilt = 96.79567353799939, timeUnknown = 0.0, timeTodo = (43.455360412597656,0)})+(54.279427,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 365, countUnknown = 1, countTodo = 40, timeSkipped = 0.0, timeBuilt = 99.32792680338025, timeUnknown = 0.0, timeTodo = (40.88410568237305,0)})+(55.549553,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 368, countUnknown = 1, countTodo = 37, timeSkipped = 0.0, timeBuilt = 101.87118165567517, timeUnknown = 0.0, timeTodo = (38.3088493347168,0)})+(56.90669,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 371, countUnknown = 1, countTodo = 34, timeSkipped = 0.0, timeBuilt = 104.48744599893689, timeUnknown = 0.0, timeTodo = (35.06652069091797,0)})+(58.179817,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 372, countUnknown = 1, countTodo = 33, timeSkipped = 0.0, timeBuilt = 107.11970918253064, timeUnknown = 0.0, timeTodo = (32.46625900268555,0)})+(59.453945,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 380, countUnknown = 1, countTodo = 25, timeSkipped = 0.0, timeBuilt = 109.69997041299939, timeUnknown = 0.0, timeTodo = (29.24193572998047,0)})+(61.17312,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 387, countUnknown = 1, countTodo = 18, timeSkipped = 0.0, timeBuilt = 114.0083963163197, timeUnknown = 0.0, timeTodo = (24.391448974609375,0)})+(62.17922,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 387, countUnknown = 1, countTodo = 18, timeSkipped = 0.0, timeBuilt = 114.0083963163197, timeUnknown = 0.0, timeTodo = (24.391448974609375,0)})+(63.787376,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 390, countUnknown = 1, countTodo = 15, timeSkipped = 0.0, timeBuilt = 116.61765687540174, timeUnknown = 0.0, timeTodo = (21.717185974121094,0)})+(67.25372,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 393, countUnknown = 1, countTodo = 12, timeSkipped = 0.0, timeBuilt = 118.84489076212049, timeUnknown = 0.0, timeTodo = (19.470962524414063,0)})+(69.114914,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 399, countUnknown = 1, countTodo = 6, timeSkipped = 0.0, timeBuilt = 124.42945497110486, timeUnknown = 0.0, timeTodo = (13.024314880371094,0)})+(70.91309,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 402, countUnknown = 1, countTodo = 3, timeSkipped = 0.0, timeBuilt = 127.54076020792127, timeUnknown = 0.0, timeTodo = (10.791084289550781,0)})+(72.67527,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 404, countUnknown = 1, countTodo = 1, timeSkipped = 0.0, timeBuilt = 129.2949411161244, timeUnknown = 0.0, timeTodo = (8.603858947753906,0)})+(73.68037,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 404, countUnknown = 1, countTodo = 1, timeSkipped = 0.0, timeBuilt = 129.2949411161244, timeUnknown = 0.0, timeTodo = (8.603858947753906,0)})+(74.683464,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 404, countUnknown = 1, countTodo = 1, timeSkipped = 0.0, timeBuilt = 129.2949411161244, timeUnknown = 0.0, timeTodo = (8.603858947753906,0)})+(75.68657,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 404, countUnknown = 1, countTodo = 1, timeSkipped = 0.0, timeBuilt = 129.2949411161244, timeUnknown = 0.0, timeTodo = (8.603858947753906,0)})+(76.68967,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 404, countUnknown = 1, countTodo = 1, timeSkipped = 0.0, timeBuilt = 129.2949411161244, timeUnknown = 0.0, timeTodo = (8.603858947753906,0)})+(77.69477,Progress {isFailure = Nothing, countSkipped = 0, countBuilt = 404, countUnknown = 1, countTodo = 1, timeSkipped = 0.0, timeBuilt = 129.2949411161244, timeUnknown = 0.0, timeTodo = (8.603858947753906,0)})
+ src/Test/Random.hs view
@@ -0,0 +1,147 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE PatternGuards #-}++module Test.Random(main) where++import Development.Shake+import Numeric.Extra+import Test.Type+import Control.Exception.Extra+import Control.Monad+import Data.List+import Data.Maybe+import General.GetOpt+import System.Environment+import System.Exit+import System.Random+import General.Extra+import qualified System.IO.Extra as IO+import System.Time.Extra+++inputRange = [1..10]++data Value = Single Int | Multiple [[Value]]+    deriving (Read,Show,Eq)++data Source = Input Int | Output Int | Bang+    deriving (Read,Show)++data Logic = Logic Int [[Source]]+           | Want [Int]+    deriving (Read,Show)++arg = [Option "" ["arg"] (ReqArg Right "") ""]++main = testBuildArgs test arg $ \args -> do+    let toFile (Input i) = "input-" ++ show i ++ ".txt"+        toFile (Output i) = "output-" ++ show i ++ ".txt"+        toFile Bang = error "BANG"++    let randomSleep = liftIO $ do+            i <- randomRIO (0, 25)+            sleep $ intToDouble i / 100++    forM_ (map read $ filter (isNothing . asDuration) args) $ \case+        Want xs -> want $ map (toFile . Output) xs+        Logic out srcs -> toFile (Output out) %> \out -> do+            res <- fmap (show . Multiple) $ forM srcs $ \src -> do+                randomSleep+                need $ map toFile src+                mapM (liftIO . fmap read . IO.readFile' . toFile) src+            randomSleep+            writeFileChanged out res+++asDuration :: String -> Maybe Double+asDuration x+    | "s" `isSuffixOf` x, [(i,"")] <- reads $ init x = Just i+    | "m" `isSuffixOf` x, [(i,"")] <- reads $ init x = Just $ i * 60+    | otherwise = Nothing+++test build = do+    limit <- do+        args <- getArgs+        let bound = listToMaybe $ reverse $ mapMaybe asDuration args+        time <- offsetTime+        pure $ when (isJust bound) $ do+            now <- time+            when (now > fromJust bound) exitSuccess++    forM_ [1..] $ \count -> do+        limit+        putStrLn $ "* PERFORMING RANDOM TEST " ++ show count+        build ["clean"]+        build [] -- to create the directory+        forM_ inputRange $ \i ->+            writeFile ("input-" ++ show i ++ ".txt") $ show $ Single i+        logic <- randomLogic+        runLogic [] logic+        chng <- filterM (const randomIO) inputRange+        forM_ chng $ \i ->+            writeFile ("input-" ++ show i ++ ".txt") $ show $ Single $ negate i+        runLogic chng logic+        forM_ inputRange $ \i ->+            writeFile ("input-" ++ show i ++ ".txt") $ show $ Single i+        logicBang <- addBang =<< addBang logic+        j <- randomRIO (1::Int,8)+        res <- try_ $ build $ "--exception" : ("-j" ++ show j) : map ((++) "--arg=" . show) (logicBang ++ [Want [i | Logic i _ <- logicBang]])+        case res of+            Left err+                | "BANG" `isInfixOf` show err -> pure () -- error I expected+                | otherwise -> error $ "UNEXPECTED ERROR: " ++ show err+            _ -> pure () -- occasionally we only put BANG in places with no dependenies that don't get rebuilt+        runLogic [] $ logic ++ [Want [i | Logic i _ <- logic]]+        where+            runLogic :: [Int] -> [Logic] -> IO ()+            runLogic negated xs = do+                let poss = [i | Logic i _ <- xs]+                i <- randomRIO (0, 7)+                wants <- replicateM i $ do+                    i <- randomRIO (0, 5)+                    replicateM i $ randomElem poss+                sleepFileTime+                j <- randomRIO (1::Int,8)+                build $ ("-j" ++ show j) : map ((++) "--arg=" . show) (xs ++ map Want wants)++                let value i =+                        let ys = headErr [ys | Logic j ys <- xs, j == i]+                        in Multiple $ flip map ys $ map $ \case+                            Input i -> Single $ if i `elem` negated then negate i else i+                            Output i -> value i+                            Bang -> error "BANG"+                forM_ (concat wants) $ \i -> do+                    let wanted = value i+                    got <- fmap read $ IO.readFile' $ "output-" ++ show i ++ ".txt"+                    when (wanted /= got) $+                        error $ "INCORRECT VALUE for " ++ show i+++addBang :: [Logic] -> IO [Logic]+addBang xs = do+    i <- randomRIO (0, length xs - 1)+    let (before,now:after) = splitAt i xs+    now <- f now+    pure $ before ++ now : after+    where+        f (Logic log xs) = do+            i <- randomRIO (0, length xs)+            let (before,after) = splitAt i xs+            pure $ Logic log $ before ++ [Bang] : after+        f x = pure x+++randomLogic :: IO [Logic] -- only Logic constructors+randomLogic = do+    rules <- randomRIO (1,100)+    f rules $ map Input inputRange+    where+        f 0 _ = pure []+        f i avail = do+            needs <- randomRIO (0,3)+            xs <- replicateM needs $ do+                ns <- randomRIO (0,3)+                replicateM ns $ randomElem avail+            let r = Logic i xs+            (r:) <$> f (i-1) (Output i:avail)
+ src/Test/Rebuild.hs view
@@ -0,0 +1,66 @@++module Test.Rebuild(main) where++import Development.Shake+import Test.Type+import Text.Read+import Data.List.Extra+import Control.Monad+import General.GetOpt++data Opt = Timestamp String | Pattern Pat++opts = [Option "" ["timestamp"] (ReqArg (Right . Timestamp) "VALUE") "Value used to detect what has rebuilt when"+       ,Option "" ["pattern"] (ReqArg (fmap Pattern . readEither) "PATTERN")  "Which file rules to use (%>, &?> etc)"]++main = testBuildArgs test opts $ \args -> do+    let timestamp = concat [x | Timestamp x <- args]+    let p = lastDef PatWildcard [x | Pattern x <- args]+    want ["a.txt"]+    pat p "a.txt" $ \out -> do+        src <- readFile' "b.txt"+        writeFile' out $ src ++ timestamp++    pat p "b.txt" $ \out -> do+        src <- readFile' "c.txt"+        writeFile' out $ src ++ timestamp++test build =+    forM_ [minBound..maxBound :: Pat] $ \pat -> do+        build ["clean"]+        let go arg c b a flags = do+                writeFileChanged "c.txt" c+                build $ ["--timestamp=" ++ arg, "--sleep","--no-reports","--pattern=" ++ show pat] ++ flags+                assertContents "b.txt" b+                assertContents "a.txt" a++        -- check rebuild works+        go "1" "x" "x1" "x11" []+        go "2" "x" "x1" "x11" []+        go "3" "x" "x1" "x13" ["--rebuild=a.*"]+        go "4" "x" "x1" "x13" []+        go "5" "x" "x5" "x55" ["--rebuild=b.*"]+        go "6" "x" "x6" "x66" ["--rebuild"]+        go "7" "x" "x6" "x66" []+        go "8" "y" "y8" "y88" []++        -- check skip works+        go "1" "x" "x1" "x11" []+        go "2" "y" "y2" "x11" ["--skip=a.*"]+        go "3" "y" "y2" "y23" []+        go "4" "z" "y2" "y23" ["--skip=b.*"]+        go "5" "z" "y2" "y23" ["--skip=b.*"]+        go "6" "z" "z6" "z66" []+        go "7" "a" "z6" "z66" ["--skip=c.*"]+        go "8" "a" "z6" "z66" ["--skip=b.*"]+        go "9" "a" "a9" "z66" ["--skip=a.*"]+        go "0" "a" "a9" "a90" []++    {-+        -- check skip-forever works+        -- currently it does not work properly+        go "1" "x" "x1" "x11" []+        go "2" "y" "y2" "x11" ["--skip-forever=a.*"]+        go "3" "y" "y2" "x11" []+        go "4" "z" "z4" "z44" []+    -}
+ src/Test/Reschedule.hs view
@@ -0,0 +1,27 @@++module Test.Reschedule(main) where++import Development.Shake+import Test.Type+++main = testBuild test $ do+    file <- newResource "log.txt" 1+    let log x = withResource file 1 $ liftIO $ appendFile "log.txt" x+    "*.p0" %> \out -> do+        log "0"+        writeFile' out ""+    "*.p1" %> \out -> do+        reschedule 1+        log "1"+        writeFile' out ""+    "*.p2" %> \out -> do+        reschedule 2+        log "2"+        writeFile' out ""+++test build = do+    build ["clean"]+    build ["foo.p1","bar.p1","baz.p0","qux.p2"]+    assertContents "log.txt" "0211"
+ src/Test/Resources.hs view
@@ -0,0 +1,78 @@++module Test.Resources(main) where++import Development.Shake+import Test.Type+import Data.List.Extra+import System.FilePath+import Control.Exception.Extra+import System.Time.Extra+import Control.Monad+import Data.IORef+++main = testBuild test $ do+    -- test I have good Ord and Show+    do+        r1 <- newResource "test" 2+        r2 <- newResource "special" 67+        unless (r1 < r2 || r2 < r1) $ fail "Resources should have a good ordering"+        unless ("special" `isInfixOf` show r2) $ fail "Resource should contain their name when shown"++    -- test you are capped to a maximum value+    do+        let cap = 2+        inside <- liftIO $ newIORef 0+        res <- newResource "test" cap+        phony "cap" $ need ["c_file" ++ show i ++ ".txt" | i <- [1..4]]+        "c_*.txt" %> \out ->+            withResource res 1 $ do+                old <- liftIO $ atomicModifyIORef inside $ \i -> (i+1,i)+                when (old >= cap) $ fail "Too many resources in use at one time"+                liftIO $ sleep 0.1+                liftIO $ atomicModifyIORef inside $ \i -> (i-1,i)+                writeFile' out ""++    -- test things can still run while you are blocked on a resource+    do+        done <- liftIO $ newIORef 0+        lock <- newResource "lock" 1+        phony "schedule" $+            need $ map ("s_" ++) $ "lock1":"done":["free" ++ show i | i <- [1..10]] ++ ["lock2"]+        "s_done" %> \out -> do+            need ["s_lock1","s_lock2"]+            done <- liftIO $ readIORef done+            when (done < 10) $ fail "Not all managed to schedule while waiting"+            writeFile' out ""+        "s_lock*" %> \out -> do+            withResource lock 1 $ liftIO $ sleep 0.5+            writeFile' out ""+        "s_free*" %> \out -> do+            liftIO $ atomicModifyIORef done $ \i -> (i+1,())+            writeFile' out ""++    -- test that throttle works properly+    do+        res <- newThrottle "throttle" 2 0.4+        phony "throttle" $ need ["t_file1.1","t_file2.1","t_file3.2","t_file4.1","t_file5.2"]+        "t_*.*" %> \out -> do+            withResource res (read $ drop1 $ takeExtension out) $+                when (takeBaseName out == "t_file3") $ liftIO $ sleep 0.2+            writeFile' out ""+++test build = do+    build ["-j2","cap","--clean"]+    build ["-j4","cap","--clean"]+    build ["-j10","cap","--clean"]+    build ["-j2","schedule","--clean"]++    forM_ ["-j1","-j8"] $ \flags ->+        -- we are sometimes over the window if the machine is "a bit loaded" at some particular time+        -- therefore we rerun the test three times, and only fail if it fails on all of them+        retry 3 $ do+            (s, _) <- duration $ build [flags,"throttle","--no-report","--clean"]+            -- the 0.1s cap is a guess at an upper bound for how long everything else should take+            -- and should be raised on slower machines+            assertBool (s >= 1.4 && s < 1.8) $+                "Bad throttling, expected to take 1.4s + computation time (cap of 0.4s), took " ++ show s ++ "s"
+ src/Test/Self.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable, TypeFamilies #-}++module Test.Self(main, cabalBuildDepends) where++import Development.Shake+import Development.Shake.Classes+import Development.Shake.FilePath+import Test.Type++import Control.Monad.Extra+import Data.Char+import Data.List.Extra+import System.Info.Extra+++newtype GhcPkg = GhcPkg () deriving (Show,Typeable,Eq,Hashable,Binary,NFData)+newtype GhcFlags = GhcFlags () deriving (Show,Typeable,Eq,Hashable,Binary,NFData)++type instance RuleResult GhcPkg = [String]+type instance RuleResult GhcFlags = [String]++-- Doesn't work on CI, seems self-building under `cabal test` is just hard+main = testBuild (notCI . defaultTest) $ do+    let moduleToFile ext xs = replace "." "/" xs <.> ext+    want ["Main" <.> exe]++    -- fixup to cope with Cabal's generated files+    let fixPaths x = if x == "Paths_shake.hs" then "Paths.hs" else x++    ghcPkg <- addOracleHash $ \GhcPkg{} -> do+        Stdout out <- quietly $ cmd "ghc-pkg list --simple-output"+        pure $ words out++    ghcFlags <- addOracleHash $ \GhcFlags{} ->+        map ("-package=" ++) <$> readFileLines ".pkgs"++    let ghc args = do+            trackAllow ["**/package.cache", "**/.ghc.environment.*"]+            -- since ghc-pkg includes the ghc package, it changes if the version does+            ghcPkg $ GhcPkg ()+            flags <- ghcFlags $ GhcFlags ()+            cmd "ghc" flags args++    "Main" <.> exe %> \out -> do+        src <- readFileLines "Run.deps"+        let os = map (moduleToFile "o") $ "Run" : src+        need os+        ghc $ ["-o",out] ++ os++    "**/*.deps" %> \out -> do+        dep <- readFileLines $ out -<.> "dep"+        let xs = map (moduleToFile "deps") dep+        need xs+        ds <- nubOrd . sort . (++) dep <$> concatMapM readFileLines xs+        writeFileLines out ds++    "**/*.dep" %> \out -> do+        src <- readFile' $ shakeRoot </> "src" </> fixPaths (out -<.> "hs")+        let xs = hsImports src+        xs <- filterM (doesFileExist . (\x -> shakeRoot </> "src" </> x) . fixPaths . moduleToFile "hs") xs+        writeFileLines out xs++    ["**/*.o","**/*.hi"] &%> \[out,_] -> do+        deps <- readFileLines $ out -<.> "deps"+        let hs = shakeRoot </> "src" </> fixPaths (out -<.> "hs")+        need $ hs : map (moduleToFile "hi") deps+        ghc ["-c",hs,"-i" ++ shakeRoot </> "src","-main-is","Run.main"+            ,"-hide-all-packages","-outputdir=."+            ,"-DPORTABLE"] -- to test one CPP branch++    ".pkgs" %> \out -> do+        src <- readFile' $ shakeRoot </> "shake.cabal"+        writeFileLines out $ sort $ cabalBuildDepends src+++---------------------------------------------------------------------+-- GRAB INFORMATION FROM FILES++hsImports :: String -> [String]+hsImports xs = [ takeWhile (\x -> isAlphaNum x || x `elem` "._") $ dropWhile (not . isUpper) x+               | x <- concatMap (wordsBy (== ';')) $ lines xs, "import " `isPrefixOf` trim x]+++-- FIXME: Should actually parse the list from the contents of the .cabal file+cabalBuildDepends :: String -> [String]+cabalBuildDepends _ = packages ++ ["unix" | not isWindows]++packages = words $+    "base transformers binary unordered-containers hashable heaps time bytestring primitive " +++    "filepath directory process deepseq random utf8-string extra js-dgtable js-jquery js-flot filepattern"
+ src/Test/SelfMake.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable, TypeFamilies #-}++module Test.SelfMake(main) where++import Development.Shake+import Development.Shake.Classes+import Development.Shake.FilePath+import Development.Shake.Util+import Test.Self(cabalBuildDepends)+import Test.Type++import Data.List.Extra+++newtype GhcPkg = GhcPkg () deriving (Show,Typeable,Eq,Hashable,Binary,NFData)+newtype GhcFlags = GhcFlags () deriving (Show,Typeable,Eq,Hashable,Binary,NFData)++type instance RuleResult GhcPkg = [String]+type instance RuleResult GhcFlags = [String]++-- Doesn't work on CI, seems self-building under `cabal test` is just hard+main = testBuild (notCI . defaultTest) $ do+    want ["Main" <.> exe]++    ghcPkg <- addOracleHash $ \GhcPkg{} -> do+        Stdout out <- quietly $ cmd "ghc-pkg list --simple-output"+        pure $ words out++    ghcFlags <- addOracleHash $ \GhcFlags{} ->+        map ("-package=" ++) <$> readFileLines ".pkgs"++    let ghc args = do+            trackAllow ["**/package.cache", "**/.ghc.environment.*"]+            -- since ghc-pkg includes the ghc package, it changes if the version does+            ghcPkg $ GhcPkg ()+            flags <- ghcFlags $ GhcFlags ()+            cmd "ghc" flags args++    "Main" <.> exe %> \out -> do+        let run = shakeRoot </> "src/Run.hs"+        copyFileChanged (shakeRoot </> "src" </> "Paths.hs") "Paths_shake.hs"+        let flags =+                ["-i" ++ shakeRoot </> "src","-dep-suffix=.","-main-is","Run.main"+                ,"-hide-all-packages","-outputdir=."+                ,"-DPORTABLE","-fwarn-unused-imports","-Werror"] -- to test one CPP branch++        trackAllow ["**/*.o","**/*.hi","Makefile"]+        ghc $ ["-M",run] ++ flags+        need . concatMap (filter (\x -> takeExtension x == ".hs") . snd) . parseMakefile =<< liftIO (readFile "Makefile")+        ghc $ ["-o",out,run,"-j4"] ++ flags++    ".pkgs" %> \out -> do+        src <- readFile' $ shakeRoot </> "shake.cabal"+        writeFileLines out $ sort $ cabalBuildDepends src
+ src/Test/Tar.hs view
@@ -0,0 +1,14 @@++module Test.Tar(main) where++import Development.Shake+import System.FilePath+import Test.Type+++main = testBuild defaultTest $ do+    want ["result.tar"]+    "result.tar" %> \out -> do+        contents <- fmap (map (shakeRoot </>)) $ readFileLines $ shakeRoot </> "src/Test/Tar/list.txt"+        need contents+        cmd "tar -cf" [out] contents
+ src/Test/Tar/list.txt view
@@ -0,0 +1,3 @@+src/Test/Tar.hs+src/Run.hs+src/Test/Tar/list.txt
+ src/Test/Targets.hs view
@@ -0,0 +1,60 @@+module Test.Targets(main) where++import Development.Shake+import Development.Shake.Internal.Core.Rules (getHelpSuffix)+import Test.Type++main :: IO () -> IO ()+main _sleeper = do+    targets <- getTargets shakeOptions rules+    targets === expected+    helpSuffix <- getHelpSuffix shakeOptions rules+    helpSuffix === ["Don't Panic", "Know where your towel is"]++rules :: Rules ()+rules = do+    withTargetDocs "A phony target" $ phony "phony1" $ pure ()++    "file1" %> \_ -> pure ()+    ["file2", "file3"] |%> \_ -> pure ()+    ["file4", "file5"] &%> \_ -> pure ()++    "file6" %> \_ -> pure ()+    ["file7", "file8"] |%> \_ -> pure ()+    ["file9", "file10"] &%> \_ -> pure ()++    withTargetDocs "Builds something really good" $ phony "phony2" $ pure ()+    withTargetDocs "bad docs" $ do+        withTargetDocs "a great file" $ "file11" %> \_ -> pure ()+        withTargetDocs "awesome files" $ ["file12", "file13"] &%> \_ -> pure ()+        phony "Foo" $ pure ()+        withoutTargets $ phony "Bar" $ pure ()++    addHelpSuffix "Don't Panic"+    addHelpSuffix "Know where your towel is"+++expected :: [(String, Maybe String)]+expected =+    [ "phony1" * Just "A phony target"++    , "file1" *  Nothing+    , "file2" *  Nothing+    , "file3" *  Nothing+    , "file4" *  Nothing+    , "file5" *  Nothing++    , "file6" *  Nothing+    , "file7" *  Nothing+    , "file8" *  Nothing+    , "file9" *  Nothing+    , "file10" * Nothing++    , "phony2" * Just "Builds something really good"++    , "file11" * Just "a great file"+    , "file12" * Just "awesome files"+    , "file13" * Just "awesome files"+    , "Foo" * Just "bad docs"+    ]+    where (*) = (,)
+ src/Test/Thread.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE ScopedTypeVariables, TupleSections #-}++module Test.Thread(main) where++import General.Cleanup+import General.Thread+import Control.Exception.Extra+import Control.Concurrent.Extra+import Data.Either.Extra+import Data.IORef+import Test.Type+++main = testSimple $ do+    ref <- newIORef 0+    let finish = atomicModifyIORef ref $ \x -> (x+1, ())+    let finished want = do+            got <- atomicModifyIORef ref (0,)+            want === got++    pauser <- newEmptyMVar+    let pause = takeMVar pauser+    let unpause = putMVar pauser ()++    let isAnswer x act = do+            r <- assertWithin 1 $ try_ act+            mapLeft show r === Right x+    let isException x act = do+            r <- assertWithin 1 $ try_ act+            mapLeft fromException r === Left (Just x)++    putStrLn "## allocateThread, spanwed finishes first"+    isAnswer 1 $ withCleanup $ \cleanup -> do+        allocateThread cleanup finish+        sleep 0.1+        pure 1+    finished 1++    putStrLn "## allocateThread, main finishes first"+    isAnswer 1 $ withCleanup $ \cleanup -> do+        allocateThread cleanup $ (unpause >> sleep 100) `finally` finish+        pause+        pure 1+    finished 1++    putStrLn "## allocateThread, spawned throws an exception"+    isException Overflow $ withCleanup $ \cleanup -> do+        allocateThread cleanup $ pause >> throw Overflow+        (unpause >> sleep 100) `finally` finish+    finished 1++    putStrLn "## allocateThread, main throws an exception"+    isException Overflow $ withCleanup $ \cleanup -> do+        allocateThread cleanup $ (unpause >> sleep 100) `finally` finish+        pause+        throw Overflow+        pure 1+    finished 1++    putStrLn "## withThreadsBoth, both succeed"+    isAnswer (2,3) $ withThreadsBoth (pure 2) (pure 3)++    putStrLn "## withThreadsBoth, left fails"+    isException Overflow $ withThreadsBoth (pause >> throw Overflow >> pure 1) ((unpause >> pure 3) `finally` finish)+    finished 1++    putStrLn "## withThreadsBoth, right fails"+    isException Overflow $ withThreadsBoth ((unpause >> pure 3) `finally` finish) (pause >> throw Overflow >> pure 1)+    finished 1
+ src/Test/Tup.hs view
@@ -0,0 +1,44 @@++module Test.Tup(main) where++import Development.Shake+import Development.Shake.Config+import Development.Shake.FilePath+import Development.Shake.Util+import Test.Type+import Data.Maybe+import Control.Monad+import System.Info.Extra+++-- Running ar on Mac seems to break in CI - not sure why+main = testBuild (unless isMac . defaultTest) $ do+    -- Example inspired by http://gittup.org/tup/ex_multiple_directories.html+    usingConfigFile $ shakeRoot </> "src/Test/Tup/root.cfg"++    action $ do+        keys <- getConfigKeys+        need [x -<.> exe | x <- keys, takeExtension x == ".exe"]++    let objects dir key = do+            let f x | takeExtension x == ".c" = dir </> x -<.> "o"+                    | takeExtension x == ".a" = takeBaseName x </> "lib" ++ x+                    | otherwise = error $ "Unknown extension, " ++ x+            x <- fromMaybe (error $ "Missing config key, " ++ key) <$> getConfig key+            pure $ map f $ words x++    (\x -> x -<.> exe == x) ?> \out -> do+        os <- objects "" $ takeBaseName out <.> "exe"+        need os+        cmd "gcc" os "-o" [out]++    "//lib*.a" %> \out -> do+        os <- objects (drop 3 $ takeBaseName out) $ drop 3 $ takeFileName out+        need os+        cmd "ar crs" [out] os++    "//*.o" %> \out -> do+        let src = shakeRoot </> "src/Test/Tup" </> out -<.> "c"+        need [src]+        cmd_ "gcc -c -MMD -MF" [out -<.> "d"] [src] "-o" [out] "-O2 -Wall" ["-I" ++ shakeRoot </> "src/Test/Tup/newmath"]+        neededMakefileDependencies $ out -<.> "d"
+ src/Test/Tup/hello.c view
@@ -0,0 +1,9 @@+#include <stdio.h>+#include "square.h"++int main(void)+{+    printf("Hi, everybody!\n");+    printf("Five squared is: %i\n", square(5));+    return 0;+}
+ src/Test/Tup/newmath/root.cfg view
@@ -0,0 +1,2 @@++newmath.a = square.c
+ src/Test/Tup/newmath/square.c view
@@ -0,0 +1,6 @@+#include "square.h"++int square(int x)+{+    return x * x;+}
+ src/Test/Tup/newmath/square.h view
@@ -0,0 +1,1 @@+int square(int x);
+ src/Test/Tup/root.cfg view
@@ -0,0 +1,4 @@++hello.exe = hello.c newmath.a++include ../../src/Test/Tup/newmath/root.cfg
+ src/Test/Type.hs view
@@ -0,0 +1,351 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable, ScopedTypeVariables #-}++module Test.Type(+    sleep, sleepFileTime, sleepFileTimeCalibrate,+    testBuildArgs, testBuild, testSimple, testNone,+    shakeRoot,+    defaultTest, hasTracker, notCI, notWindowsCI, notMacCI,+    copyDirectoryChanged, copyFileChangedIO,+    assertWithin,+    assertBool, assertBoolIO, assertException, assertExceptionAfter,+    assertContents, assertContentsUnordered, assertContentsWords, assertContentsInfix,+    assertExists, assertMissing,+    assertTimings,+    (===),+    (&?%>),+    Pat(PatWildcard), pat,+    BinarySentinel(..), RandomType(..),+    ) where++import Development.Shake+import Development.Shake.Classes+import Development.Shake.Forward+import Development.Shake.Internal.FileName+import General.Extra+import Development.Shake.Internal.FileInfo+import Development.Shake.FilePath+import Development.Shake.Internal.Paths++import Control.Exception.Extra+import Control.Monad.Extra+import Data.List.Extra+import Text.Read(readMaybe)+import Data.Maybe+import Data.Either+import Data.Typeable+import System.Directory.Extra as IO+import System.Environment+import System.Random+import General.GetOpt+import System.IO.Extra as IO+import System.Time.Extra+import System.Info.Extra+++testBuildArgs+    :: (([String] -> IO ()) -> IO ()) -- ^ The test driver+    -> [OptDescr (Either String a)] -- ^ Arguments the test can accept+    -> ([a] -> Rules ()) -- ^ The Shake script under test+    -> IO () -- ^ Sleep function, driven by passing @--sleep@+    -> IO ()+testBuildArgs f opts g = shakenEx False opts f+    (\os args -> if null args then g os else want args >> withoutActions (g os))++testBuild+    :: (([String] -> IO ()) -> IO ()) -- ^ The test driver+    -> Rules () -- ^ The Shake script under test+    -> IO () -- ^ Sleep function, driven by passing @--sleep@+    -> IO ()+testBuild f g = testBuildArgs f [] (const g)++testSimple :: IO () -> IO () -> IO ()+testSimple act = testBuild (const act) (pure ())++testNone :: IO () -> IO ()+testNone _ = pure ()++shakenEx+    :: Bool+    -> [OptDescr (Either String a)]+    -> (([String] -> IO ()) -> IO ())+    -> ([a] -> [String] -> Rules ())+    -> IO ()+    -> IO ()+shakenEx reenter options test rules sleeper = do+    initDataDirectory++    name:args <- getArgs+    putStrLn $ "## BUILD " ++ unwords (name:args)+    let forward = "--forward" `elem` args+    args <- pure $ delete "--forward" args+    let out = "output/" ++ name ++ "/"+    let change = if not reenter then withCurrentDirectory out else id+    let clean = do+            now <- getCurrentDirectory+            when (takeBaseName now /= name) $+                fail $ "Clean went horribly wrong! Dangerous deleting: " ++ show now+            withCurrentDirectory (now </> "..") $ do+                removePathForcibly now+                createDirectoryRecursive now+    unless reenter $ createDirectoryRecursive out+    case args of+        "test":_ -> do+            putStrLn $ "## TESTING " ++ name+            change $ test (\args -> withArgs (name:args) $ shakenEx True options test rules sleeper)+            putStrLn $ "## FINISHED TESTING " ++ name++        "clean":args -> do+            when (args /= []) $ fail "Unexpected additional arguments to 'clean'"+            change clean++        "perturb":args -> forever $ do+            del <- removeFilesRandom out+            threads <- randomRIO (1,4)+            putStrLn $ "## TESTING PERTURBATION (" ++ show del ++ " files, " ++ show threads ++ " threads)"+            shake shakeOptions{shakeFiles=out, shakeThreads=threads, shakeVerbosity=Error} $ rules [] args++        args -> change $ do+            t <- tracker+            opts <- pure shakeOptions{shakeFiles = "."}+            cwd <- getCurrentDirectory+            opts <- pure $ if forward then forwardOptions opts{shakeLintInside=[""]} else opts+                {shakeLint = Just t+                ,shakeLintInside = [cwd </> ".." </> ".."]+                ,shakeLintIgnore = [".cabal-sandbox/**",".stack-work/**","../../.stack-work/**"]}+            withArgs args $ do+                let optionsBuiltin = optionsEnumDesc+                        [(Clean, "Clean before building.")+                        ,(Sleep, "Pause before executing.")+                        ,(UsePredicate, "Use &?> in preference to &%>")]+                shakeArgsOptionsWith opts (optionsBuiltin `mergeOptDescr` options) $ \so extra files -> do+                    let (extra1, extra2) = partitionEithers extra+                    when (Clean `elem` extra1) clean+                    when (Sleep `elem` extra1) sleeper+                    so <- pure $ if UsePredicate `notElem` extra1 then so else+                        so{shakeExtra = addShakeExtra UsePredicateYes $ shakeExtra so}+                    if "clean" `elem` files then+                        clean >> pure Nothing+                    else pure $ Just $ (,) so $ do+                        -- if you have passed sleep, suppress the "no actions" warning+                        when (Sleep `elem` extra1) $ action $ pure ()+                        rules extra2 files++data Flags+    = Clean -- ^ Clean all the files before starting+    | Sleep -- ^ Call 'sleepFileTimeCalibrate' before starting+    | UsePredicate -- ^ Use &?> in preference to &%>+      deriving (Eq,Show)++data UsePredicateYes = UsePredicateYes deriving Typeable++(&?%>) :: [FilePattern] -> ([FilePath] -> Action ()) -> Rules ()+deps &?%> act = do+    so :: Maybe UsePredicateYes <- getShakeExtraRules+    if isJust so+        then (\x -> if x `elem` deps then Just deps else Nothing) &?> act+        else deps &%> act++-- A way to get back to the source files after you get directory changed+shakeRoot :: FilePath+shakeRoot = "../.."++tracker :: IO Lint+tracker = do+    fsatrace <- findExecutable $ "fsatrace" <.> exe+    -- Tracking on a Mac is pretty unreliable+    pure $ if not isMac && isJust fsatrace then LintFSATrace else LintBasic++-- Tests that don't currently work on CI+notCI :: IO () -> IO ()+notCI act = do+    b <- lookupEnv "CI"+    when (isNothing b) act++-- Tests that don't currently work on Windows CI+notWindowsCI :: IO () -> IO ()+notWindowsCI = if isWindows then notCI else id++-- Tests that don't currently work on Mac CI+notMacCI :: IO () -> IO ()+notMacCI = if isMac then notCI else id++hasTracker :: IO Bool+hasTracker = do+    t <- tracker+    pure $ t == LintFSATrace++assertFail :: String -> IO a+assertFail msg = error $ "ASSERTION FAILED: " ++ msg++assertBool :: Bool -> String -> IO ()+assertBool b msg = unless b $ assertFail msg++assertBoolIO :: IO Bool -> String -> IO ()+assertBoolIO b msg = do b <- b; assertBool b msg++infix 4 ===++(===) :: (Show a, Eq a) => a -> a -> IO ()+a === b = assertBool (a == b) $ "failed in ===\nLHS: " ++ show a ++ "\nRHS: " ++ show b+++assertExists :: FilePath -> IO ()+assertExists file = do+    b <- IO.doesFileExist file+    assertBool b $ "File was expected to exist, but is missing: " ++ file++assertMissing :: FilePath -> IO ()+assertMissing file = do+    b <- IO.doesFileExist file+    assertBool (not b) $ "File was expected to be missing, but exists: " ++ file++assertWithin :: Seconds -> IO a -> IO a+assertWithin n act = do+    t <- timeout n act+    case t of+        Nothing -> assertFail $ "Expected to complete within " ++ show n ++ " seconds, but did not"+        Just v -> pure v++assertContents :: FilePath -> String -> IO ()+assertContents file want = do+    got <- IO.readFile' file+    assertBool (want == got) $ "File contents are wrong: " ++ file ++ "\nWANT: " ++ want ++ "\nGOT: " ++ got++assertContentsInfix :: FilePath -> String -> IO ()+assertContentsInfix file want = do+    got <- IO.readFile' file+    assertBool (want `isInfixOf` got) $ "File contents are wrong: " ++ file ++ "\nWANT (infix): " ++ want ++ "\nGOT: " ++ got++assertContentsOn :: (String -> String) -> FilePath -> String -> IO ()+assertContentsOn f file want = do+    got <- IO.readFile' file+    assertBool (f want == f got) $ "File contents are wrong: " ++ file ++ "\nWANT: " ++ want ++ "\nGOT: " ++ got +++                                   "\nWANT (transformed): " ++ f want ++ "\nGOT (transformed): " ++ f got++assertContentsWords :: FilePath -> String -> IO ()+assertContentsWords = assertContentsOn (unwords . words)++assertContentsUnordered :: FilePath -> [String] -> IO ()+assertContentsUnordered file xs = assertContentsOn (unlines . sort . lines) file (unlines xs)++assertExceptionAfter :: (String -> String) -> [String] -> IO a -> IO ()+assertExceptionAfter tweak parts act = do+    res <- try_ act+    case res of+        Left err -> let s = tweak $ show err in forM_ parts $ \p ->+            assertBool (p `isInfixOf` s) $ "Incorrect exception, missing part:\nGOT: " ++ s ++ "\nWANTED: " ++ p+        Right _ -> error $ "Expected an exception containing " ++ show parts ++ ", but succeeded"++assertException :: [String] -> IO a -> IO ()+assertException = assertExceptionAfter id++assertTimings :: ([String] -> IO ()) -> [(String, Seconds)] -> IO ()+assertTimings build expect = do+    build ["--report=report.json","--no-build"]+    src <- IO.readFile' "report.json"+    let f ('[':'\"':xs)+            | (name,_:',':xs) <- break (== '\"') xs+            , num <- takeWhile (`notElem` ",]") xs+            , Just num <- readMaybe num+            = (name, num :: Double)+        f x = error $ "Failed to parse JSON output in assertTimings, " ++ show x+    let got = [f x | x <- map drop1 $ lines src, x /= ""]+    forM_ expect $ \(name, val) ->+        case lookup name got of+            Nothing -> assertFail $ "Couldn't find key " ++ show name ++ " in profiling output"+            Just v -> assertBool (v >= val && v < (val + 1)) $ "Unexpected value, got " ++ show v ++ ", hoping for " ++ show val ++ " (+ 1 sec)"+++defaultTest :: ([String] -> IO ()) -> IO ()+defaultTest build = do+    build ["--abbrev=output=$OUT","-j3","--report"]+    build ["--no-build","--report=-"]+    build []+++-- | Sleep long enough for the modification time resolution to catch up+sleepFileTime :: IO ()+sleepFileTime = sleep 1+++sleepFileTimeCalibrate :: FilePath -> IO (IO ())+sleepFileTimeCalibrate file = do+    createDirectoryRecursive $ takeDirectory file+    -- with 10 measurements can get a bit slow, see #451+    -- if it rounds to a second then 1st will be a fraction, but 2nd will be full second+    mtimes <- forM [1..2] $ \i -> fmap fst $ duration $ do+        writeFile file $ show i+        let time = fmap (fst . fromMaybe (error "File missing during sleepFileTimeCalibrate")) $+                        getFileInfo False $ fileNameFromString file+        t1 <- time+        flip loopM 0 $ \j -> do+            writeFile file $ show (i,j)+            t2 <- time+            pure $ if t1 == t2 then Left $ j+1 else Right ()+    putStrLn $ "Longest file modification time lag was " ++ show (ceiling (maximum' mtimes * 1000)) ++ "ms"+    pure $ sleep $ min 1 $ maximum' mtimes * 2+++removeFilesRandom :: FilePath -> IO Int+removeFilesRandom x = do+    files <- getDirectoryContentsRecursive x+    n <- randomRIO (0,length files)+    rs <- replicateM (length files) (randomIO :: IO Double)+    mapM_ (removeFile . snd) $ sort $ zip rs files+    pure n+++getDirectoryContentsRecursive :: FilePath -> IO [FilePath]+getDirectoryContentsRecursive dir = do+    xs <- IO.getDirectoryContents dir+    (dirs,files) <- partitionM IO.doesDirectoryExist [dir </> x | x <- xs, not $ "." `isPrefixOf` x]+    rest <- concatMapM getDirectoryContentsRecursive dirs+    pure $ files++rest+++copyDirectoryChanged :: FilePath -> FilePath -> IO ()+copyDirectoryChanged old new = do+    xs <- getDirectoryContentsRecursive old+    forM_ xs $ \from -> do+        let to = new </> drop (length $ addTrailingPathSeparator old) from+        createDirectoryRecursive $ takeDirectory to+        copyFileChangedIO from to+++copyFileChangedIO :: FilePath -> FilePath -> IO ()+copyFileChangedIO old new =+    unlessM (liftIO $ IO.doesFileExist new &&^ IO.fileEq old new) $+        copyFile old new++-- The operators %> ?> &*> &?> |?> |*> all have an isomorphism+data Pat = PatWildcard | PatPredicate | PatOrWildcard | PatAndWildcard | PatAndPredicate+    deriving (Read, Show, Enum, Bounded)++pat :: Pat -> FilePattern -> (FilePath -> Action ()) -> Rules ()+pat PatWildcard p act = p %> act+pat PatPredicate p act = (p ?==) ?> act+pat PatOrWildcard p act = [p] |%> act+pat PatAndWildcard p act =+    -- single wildcard shortcircuits, so we use multiple to avoid that+    -- and thus have to fake writing an extra file+    [p, p ++ "'"] &%> \[x,x'] -> do act x; writeFile' x' ""+pat PatAndPredicate p act = (\x -> if p ?== x then Just [x] else Nothing) &?> \[x] -> act x+++---------------------------------------------------------------------+-- TEST MATERIAL+-- Some errors require multiple modules to replicate (e.g. #506), so put that here++newtype BinarySentinel a = BinarySentinel ()+    deriving (Eq,Show,NFData,Typeable,Hashable)++instance forall a . Typeable a => Binary (BinarySentinel a) where+    put (BinarySentinel ()) = put $ show (typeRep (Proxy :: Proxy a))+    get = do+        x <- get+        let want = show (typeRep (Proxy :: Proxy a))+        if x == want then pure $ BinarySentinel () else+            error $ "BinarySentinel failed, got " ++ show x ++ " but wanted " ++ show want++newtype RandomType = RandomType (BinarySentinel ())+    deriving (Eq,Show,NFData,Typeable,Hashable,Binary)
+ src/Test/Unicode.hs view
@@ -0,0 +1,66 @@++module Test.Unicode(main) where++import Development.Shake+import Development.Shake.FilePath+import Test.Type+import Data.List.Extra+import General.GetOpt+import Control.Monad+import GHC.IO.Encoding+++-- | Decode a dull ASCII string to certain unicode points, necessary because+--   withArgs (even the UTF8 version) throws an encoding error on the > 256 code points+decode :: String -> String+decode ('e':'^':xs) = '\xEA' : decode xs -- Latin Small Letter E With Circumflex+decode (':':')':xs) = '\x263A' : decode xs -- White Smiling Face+decode (x:xs) = x : decode xs+decode [] = []++data Arg = Prefix String | Want String+opts =+    [Option "" ["prefix"] (ReqArg (Right . Prefix) "") ""+    ,Option "" ["want"] (ReqArg (Right . Want) "") ""]++main = testBuildArgs test opts $ \xs -> do+    let pre = lastDef "" [decode x | Prefix x <- xs :: [Arg]]+    want [decode x | Want x <- xs]++    pre ++ "dir/*" %> \out -> do+        let src = takeDirectory (takeDirectory out) </> takeFileName out+        copyFile' src out++    pre ++ ".out" %> \out -> do+        a <- readFile' $ pre ++ "dir" </> pre <.> "source"+        b <- readFile' $ pre <.> "multi1"+        writeFile' out $ a ++ b++    ["*.multi1","*.multi2"] &%> \[m1,m2] -> do+        b <- doesFileExist $ m1 -<.> "exist"+        writeFile' m1 $ show b+        writeFile' m2 $ show b+++test build = do+    build ["clean"]+    -- Useful, if the error message starts crashing...+    -- IO.hSetEncoding IO.stdout IO.char8+    -- IO.hSetEncoding IO.stderr IO.char8+    forM_ ["normal","e^",":)","e^-:)"] $ \pre -> do+        -- If you aren't on UTF-8 file encoding it goes wrong, see+        -- https://github.com/ndmitchell/shake/pull/681+        enc <- liftIO getFileSystemEncoding+        if textEncodingName enc /= "UTF-8"+        then putStrLn "WARNING: filesystem encoding is not UTF-8, skipping unicode test (LANG=C ?)"+        else do+                let ext x = decode pre <.> x+                writeFile (ext "source") "x"+                build ["--prefix=" ++ pre, "--want=" ++ pre <.> "out", "--sleep"]+                assertContents (ext "out") $ "x" ++ "False"+                writeFile (ext "source") "y"+                build ["--prefix=" ++ pre, "--want=" ++ pre <.> "out", "--sleep"]+                assertContents (ext "out") $ "y" ++ "False"+                writeFile (ext "exist") ""+                build ["--prefix=" ++ pre, "--want=" ++ pre <.> "out"]+                assertContents (ext "out") $ "y" ++ "True"
+ src/Test/Util.hs view
@@ -0,0 +1,18 @@++module Test.Util(main) where++import Development.Shake.Util+import Test.Type+++main = testSimple $ do+    parseMakefile "" === []+    parseMakefile "a:b c\ndef : ee" === [("a",["b","c"]),("def",["ee"])]+    parseMakefile "a: #comment\n#comment : b\nc : d" === [("a",[]),("c",["d"])]+    parseMakefile "a \\\n\t:b" === [("a",["b"])]+    parseMakefile "#comment\\    a : b" === []+    parseMakefile "a: b c \\\n    d e\n\nf:g" === [("a",["b","c","d","e"]),("f",["g"])]+    parseMakefile "foo/bar: \\\r\n c:/a1 \\\r\n x\r\n" === [("foo/bar",["c:/a1","x"])]+    parseMakefile "output.o: src/file/with\\ space.cpp" === [("output.o",["src/file/with space.cpp"])]+    parseMakefile "a: b\\  c" === [("a",["b ","c"])]+    parseMakefile "a: b\\ c\\ d e" === [("a",["b c d","e"])]
+ src/Test/Verbosity.hs view
@@ -0,0 +1,37 @@++module Test.Verbosity(main) where++import Development.Shake+import Test.Type+++main = testBuild test $ do+    "in.txt" %> \out -> do+        a <- getVerbosity+        b <- withVerbosity Info getVerbosity+        writeFile' out $ unwords $ map show [a,b]++    "out.txt" %> \out -> do+        x <- getVerbosity+        ys <- withVerbosity Verbose $ do+            a <- getVerbosity+            need ["in.txt"] -- make sure the inherited verbosity does not get passed along+            b <- getVerbosity+            c <- quietly getVerbosity+            d <- fmap shakeVerbosity getShakeOptions+            pure [a,b,c,d]+        z <- getVerbosity+        writeFile' out $ unwords $ map show $ [x] ++ ys ++ [z]++test build = do+    build ["out.txt","--clean"]+    assertContents "in.txt" "Info Info"+    assertContents "out.txt" "Info Verbose Verbose Error Info Info"++    build ["out.txt","--clean","--verbose"]+    assertContents "in.txt" "Verbose Info"+    assertContents "out.txt" "Verbose Verbose Verbose Error Verbose Verbose"++    build ["out.txt","--clean","--quiet"]+    assertContents "in.txt" "Warn Info"+    assertContents "out.txt" "Warn Verbose Verbose Error Warn Warn"
+ src/Test/Version.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving, DeriveDataTypeable #-}++module Test.Version(main) where++import Development.Shake+import Development.Shake.Classes+import General.GetOpt+import Data.List.Extra+import Text.Read+import Test.Type+++newtype Opts = Ver Int+opts = [Option "" ["ver"] (ReqArg (fmap Ver . readEither) "INT") ""]++newtype Oracle = Oracle ()+    deriving (Show,Eq,Hashable,Binary,NFData,Typeable)+type instance RuleResult Oracle = Int++main = testBuildArgs test opts $ \opts -> do+    want ["foo.txt","ver.txt","oracle.txt"]++    "foo.txt" %> \file -> liftIO $ appendFile file "x"++    let ver = headDef 0 [x | Ver x <- opts]+    versioned ver $ "ver.txt" %> \out -> liftIO $ appendFile out $ show ver++    versioned ver $ addOracleCache $ \(Oracle ()) -> do+        liftIO $ appendFile "oracle.in" $ show ver+        pure $ ver `mod` 2+    "oracle.txt" %> \out -> do+        v <- askOracle $ Oracle ()+        liftIO $ appendFile out $ show v+++test build = do+    writeFile "foo.txt" ""+    v1 <- getHashedShakeVersion ["foo.txt"]+    writeFile "foo.txt" "y"+    v2 <- getHashedShakeVersion ["foo.txt"]+    assertBool (v1 /= v2) "Hashes must not be equal"++    build ["clean"]+    build []+    assertContents "foo.txt" "x"+    build ["--rule-version=new"]+    assertContents "foo.txt" "xx"+    build ["--rule-version=new"]+    assertContents "foo.txt" "xx"+    build ["--rule-version=extra","--silent"]+    assertContents "foo.txt" "xxx"+    build ["--rule-version=more","--no-rule-version"]+    assertContents "foo.txt" "xxx"+    build ["--rule-version=more"]+    assertContents "foo.txt" "xxx"+    build ["--rule-version=final","--silent"]+    assertContents "foo.txt" "xxxx"++    build ["clean"]+    build []+    assertContents "ver.txt" "0"+    assertContents "foo.txt" "x"+    build ["--ver=0","--silent"]+    assertContents "ver.txt" "0"+    build ["--ver=8"]+    build ["--ver=9","--silent"]+    build ["--ver=9","--silent"]+    build ["--ver=3","--silent"]+    assertContents "ver.txt" "0893"+    assertContents "oracle.in" "0893"+    -- when you change version you don't do cutoff+    assertContents "oracle.txt" "0011"+    assertContents "foo.txt" "x"