{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable, ScopedTypeVariables, NamedFieldPuns #-}{-# LANGUAGE ViewPatterns, RecordWildCards, FlexibleInstances, TypeFamilies, ConstraintKinds #-}moduleDevelopment.Shake.Internal.Rules.File(need ,needHasChanged ,needBS ,needed ,neededBS ,want ,trackRead ,trackWrite ,trackAllow ,produces ,defaultRuleFile ,(%> ),(|%> ),(?> ),phony ,(~> ),phonys ,resultHasChanged ,-- * Internal onlyFileQ (..),FileA (..),fileStoredValue ,fileEqualValue ,EqualCost (..),fileForward )whereimportControl.Monad.ExtraimportControl.Monad.IO.ClassimportData.TypeableimportData.ListimportData.MaybeimportqualifiedData.ByteString.Char8asBSimportqualifiedData.HashSetasSetimportForeign.StorableimportData.WordimportData.MonoidimportGeneral.Binary importGeneral.Extra importDevelopment.Shake.Internal.Core.Types importDevelopment.Shake.Internal.Core.Rules importDevelopment.Shake.Internal.Core.Build importDevelopment.Shake.Internal.Core.Action importDevelopment.Shake.Internal.FileName importDevelopment.Shake.Internal.Rules.Rerun importDevelopment.Shake.Classes importDevelopment.Shake.FilePath (toStandard )importDevelopment.Shake.Internal.FilePattern importDevelopment.Shake.Internal.FileInfo importDevelopment.Shake.Internal.Options importDevelopment.Shake.Internal.Errors importSystem.FilePath(takeDirectory)-- important that this is the system local filepath, or wrong slashes go wrongimportSystem.IO.Unsafe(unsafeInterleaveIO)importPreludeinfix1%> ,?> ,|%> ,~> ----------------------------------------------------------------------- TYPEStypeinstanceRuleResult FileQ =FileR -- | The unique key we use to index File rules, to avoid name clashes.newtypeFileQ =FileQ {fromFileQ ::FileName }deriving(Typeable,Eq,Hashable,Binary,BinaryEx ,NFData)-- | Raw information about a file.dataFileA =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 builddataFileR =FileR {answer ::!(MaybeFileA )-- ^ 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.dataMode =ModePhony (Action ())-- ^ An action with no file value|ModeDirect (Action ())-- ^ An action that produces this file|ModeForward (Action (MaybeFileA ))-- ^ An action that looks up a file someone else produced-- | The results of the various 'Mode' rules.dataAnswer =AnswerPhony |AnswerDirect Ver FileA |AnswerForward Ver FileA -- | The file rules we use, first is the name (as pretty as you can get).dataFileRule =FileRule String(FilePath->MaybeMode )derivingTypeable----------------------------------------------------------------------- INSTANCESinstanceShowFileQ whereshow (FileQ x )=fileNameToString x instanceBinaryEx [FileQ ]whereputEx =putEx .mapfromFileQgetEx =mapFileQ .getEx instanceNFDataFileA wherernf (FileA a b c )=rnfa `seq`rnfb `seq`rnfc instanceNFDataFileR wherernf (FileR a b )=rnfa `seq`rnfb instanceShowFileA whereshow (FileA m s h )="File {mod="++showm ++",size="++shows ++",digest="++showh ++"}"instanceShowFileR whereshow FileR {..}=showanswer instanceStorableFileA wheresizeOf _=4*3-- 4 Word32'salignment _=alignment(undefined::ModTime )peekByteOff p i =FileA <$>peekByteOffp i <*>peekByteOffp (i +4)<*>peekByteOffp (i +8)pokeByteOff p i (FileA a b c )=pokeByteOffp i a >>pokeByteOffp (i +4)b >>pokeByteOffp (i +8)c instanceBinaryEx FileA whereputEx =putExStorable getEx =getExStorable instanceBinaryEx [FileA ]whereputEx =putExStorableList getEx =getExStorableList fromAnswer::Answer ->MaybeFileA fromAnswer AnswerPhony =NothingfromAnswer(AnswerDirect _x )=Justx fromAnswer(AnswerForward _x )=Justx instanceBinaryEx Answer whereputEx AnswerPhony =memptyputEx(AnswerDirect ver x )=putExStorable ver <>putEx x putEx(AnswerForward ver x )=putEx (0::Word8)<>putExStorable ver <>putEx x getEx x =caseBS.lengthx of0->AnswerPhony i ->ifi ==sz thenf AnswerDirect x elsef AnswerForward $BS.tailx wheresz =sizeOf(undefined::Ver )+sizeOf(undefined::FileA )f ctor x =let(a ,b )=binarySplit x inctor a $getEx b ----------------------------------------------------------------------- FILE CHECK QUERIES-- | An equality check and a cost.dataEqualCost =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(MaybeFileA )fileStoredValue ShakeOptions {shakeChange=c }(FileQ x )=dores <-getFileInfo x caseres ofNothing->returnNothingJust(time ,size )|c ==ChangeModtime ->return$Just$FileA time size noFileHash Just(time ,size )->dohash <-unsafeInterleaveIO$getFileHash x return$Just$FileA time size hash fileEqualValue::ShakeOptions ->FileA ->FileA ->EqualCost fileEqualValue ShakeOptions {shakeChange=c }(FileA x1 x2 x3 )(FileA y1 y2 y3 )=casec ofChangeModtime ->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 wherebool b =ifb thenEqualCheap elseNotEqual -- | Arguments: options; is the file an input; a message for failure if the file does not exist; filenamestoredValueError::ShakeOptions ->Bool->String->FileQ ->IO(MaybeFileA ){-
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)
 return $ FileA fileInfoEq fileInfoEq fileInfoEq
-}storedValueError opts input msg x =maybedef Just<$>fileStoredValue opts2 x wheredef =ifshakeCreationCheckopts ||input thenerrorerr elseNothingerr =msg ++"\n "++fileNameToString (fromFileQx )opts2 =ifnotinput &&shakeChangeopts ==ChangeModtimeAndDigestInput thenopts {shakeChange=ChangeModtime }elseopts ----------------------------------------------------------------------- THE DEFAULT RULEdefaultRuleFile::Rules ()defaultRuleFile =doopts @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 (Justv )True)=donow <-fileStoredValue opts k return$casenow ofNothing->Just"<missing>"Justnow |fileEqualValue opts v now ==EqualCheap ->Nothing|otherwise->Just$shownow ruleLint___=returnNothingruleIdentity::ShakeOptions ->BuiltinIdentity FileQ FileR ruleIdentity opts |shakeChangeopts ==ChangeModtime =throwImpure errorNoHash ruleIdentity_=\k v ->caseanswerv ofJust(FileA _size hash )->Just$runBuilder $putExStorable size <>putExStorable hash Nothing->NothingruleRun::ShakeOptions ->(FilePath->Rebuild )->BuiltinRun FileQ FileR ruleRun opts @ShakeOptions {..}rebuildFlags o @(FileQ (fileNameToString ->xStr ))oldBin @(fmapgetEx ->old ::MaybeAnswer )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?letr =rebuildFlags xStr (ruleVer ,ruleAct ,ruleErr )<-getUserRuleInternal o (\(FileRule s _)->Justs )$\(FileRule _f )->f xStr letverEq v =Justv ==ruleVer ||caseruleAct of[]->v ==Ver 0;[(v2 ,_)]->v ==Ver v2 ;_->Falseletrebuild =doputWhen Chatty $"# "++showo caseruleAct of[]->rebuildWith Nothing[x ]->rebuildWith $Justx _->throwM ruleErr caseold of_|r ==RebuildNow ->rebuild _|r ==RebuildLater ->caseold ofJust_->-- ignoring the currently stored value, which may trigger lint has changed-- so disable lint on this fileunLint <$>retOld ChangedNothing Nothing->do-- i don't have a previous value, so assume this is a source node, and mark rebuild in futurenow <-liftIO$fileStoredValue opts o casenow ofNothing->rebuild Justnow ->doalwaysRerun ;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 ->donow <-liftIO$fileStoredValue opts o letnoHash (FileA __x )=isNoFileHash x casenow ofNothing->rebuild Justnow ->casefileEqualValue opts old now ofNotEqual ->rebuild -- if our last build used no file hashing, but this build should, then we must refresh the hashEqualCheap |ifnoHash old thenshakeChange ==ChangeModtimeAndDigestInput ||noHash now elseTrue->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 #427fileR (AnswerDirect _x )=FileR (Justx )TruefileR(AnswerForward _x )=FileR (Justx )FalsefileRAnswerPhony =FileR NothingFalseunLint (RunResult a b c )=RunResult a b c {useLint=False}retNew::RunChanged ->Answer ->Action (RunResult FileR )retNew c v =return$RunResult c (runBuilder $putEx v )$fileR v retOld::RunChanged ->Action (RunResult FileR )retOld c =return$RunResult c (fromJustoldBin )$fileR (fromJustold )-- actually run the rebuildrebuildWith act =doletanswer ctor new =doletb =case()of_|Justold <-old ,Justold <-fromAnswer old ,fileEqualValue opts old new /=NotEqual ->ChangedRecomputeSame _->ChangedRecomputeDiff retNew b $ctor new caseact ofNothing->donew <-liftIO$storedValueError opts True"Error, file does not exist and no rule available:"o answer (AnswerDirect $Ver 0)$fromJustnew Just(ver ,ModeForward act )->donew <-act casenew ofNothing->do-- Not 100% sure how you get here, but I think it involves RebuildLater and multi-file ruleshistoryDisable retNew ChangedRecomputeDiff AnswerPhony Justnew ->answer (AnswerForward $Ver ver )new Just(ver ,ModeDirect act )->docache <-historyLoad ver casecache ofJustencodedHash ->doJust(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->doact new <-liftIO$storedValueError opts False"Error, rule finished running but did not produce file:"o casenew ofNothing->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 botherhistoryDisable retNew ChangedRecomputeDiff AnswerPhony Justnew @(FileA __fileHash )->doproducesUnchecked [xStr ]res <-answer (AnswerDirect $Ver ver )new historySave ver $runBuilder $ifisNoFileHash fileHash thenthrowImpure errorNoHash elseputExStorable fileHash returnres 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 BoolresultHasChanged file =doletfilename =FileQ $fileNameFromString file res <-getDatabaseValue filename old <-return$caseresult<$>res ofNothing->NothingJust(Leftbs )->fromAnswer $getEx bs Just(Rightv )->answerv caseold ofNothing->returnTrueJustold ->doopts <-getShakeOptions new <-liftIO$fileStoredValue opts filename return$casenew ofNothing->TrueJustnew ->fileEqualValue opts old new ==NotEqual ----------------------------------------------------------------------- OPTIONS ON TOP-- | Internal method for adding forwarding actionsfileForward::String->(FilePath->Maybe(Action (MaybeFileA )))->Rules ()fileForward help act =addUserRule $FileRule help $fmapModeForward .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]-- @---- Usually @need [foo,bar]@ is preferable to @need [foo] >> need [bar]@ as the former allows greater-- parallelism, while the latter requires @foo@ to finish building before starting to build @bar@.---- 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$doapply_ fileNameFromString paths self <-getCurrentKey selfVal <-caseself ofNothing->returnNothingJustself ->getDatabaseValueGeneric self caseselfVal ofNothing->returnpaths -- never build before or not a key, so everything has changedJustselfVal ->flipfilterMpaths $\path ->dopathVal <-getDatabaseValue (FileQ $fileNameFromString path )return$casepathVal ofJustpathVal |changedpathVal >builtselfVal ->True_->FalseneedBS::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$doopts <-getShakeOptions ifisNothing$shakeLintopts thenneed xs elseneededCheck $mapfileNameFromString xs neededBS::Partial=>[BS.ByteString]->Action ()neededBS xs =withFrozenCallStack$doopts <-getShakeOptions ifisNothing$shakeLintopts thenneedBS xs elseneededCheck $mapfileNameFromByteString xs neededCheck::Partial=>[FileName ]->Action ()neededCheck xs =withFrozenCallStack$doopts <-getShakeOptions pre <-liftIO$mapM(fileStoredValue opts .FileQ )xs post <-apply_ idxs letbad =[(x ,ifisJusta then"File change"else"File created")|(x ,a ,FileR (Justb )_)<-zip3xs pre post ,maybeNotEqual (\a ->fileEqualValue opts a b )a ==NotEqual ]casebad of[]->return()(file ,msg ):_->throwM $errorStructured "Lint checking error - 'needed' file required rebuilding"[("File",Just$fileNameToString file ),("Error",Justmsg )]""-- Either trackRead or trackWritetrack::([FileQ ]->Action ())->[FilePath]->Action ()track tracker xs =doShakeOptions {shakeLintIgnore }<-getShakeOptions letignore =(?==* )shakeLintIgnore letys =filter(not.ignore )xs when(ys /=[])$tracker $map(FileQ .fileNameFromString )ys -- | Track that a file was read by the action preceeding 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 preceeding 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 'trackRead' \/ 'trackWrite' calls matching-- the pattern.trackAllow::[FilePattern ]->Action ()trackAllow ps =doletignore =(?==* )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 =doproducesChecked 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 []=return()wantxs =withFrozenCallStack$action $need xs root::String->(FilePath->Bool)->(FilePath->Action ())->Rules ()root help test act =addUserRule $FileRule help $\x ->ifnot$test x thenNothingelseJust$ModeDirect $doliftIO$createDirectoryRecursive $takeDirectoryx 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 =doaddTarget oname addPhony ("phony "++showoname ++" at "++callStackTop )$\s ->ifs ==name thenJustact elseNothing-- | 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 =doaddTarget oname addPhony (showoname ++" ~> at "++callStackTop )$\s ->ifs ==name thenJustact elseNothingaddPhony::String->(String->Maybe(Action ()))->Rules ()addPhony help act =addUserRule $FileRule help $fmapModePhony .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 =domapM_addTarget pats let(simp ,other )=partitionsimple pats casemaptoStandard simp of[]->return()[p ]->root help (\x ->toStandard x ==p )act ps ->letset =Set.fromListps inroot help (flipSet.memberset .toStandard )act unless(nullother )$letps =map(?== )other inpriority 0.5$root help (\x ->any($x )ps )act wherehelp =showpats ++" |%> 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$(ifsimple test thenidelsepriority 0.5)$doaddTarget test root (showtest ++" %> at "++callStackTop )(test ?== )act