{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable, ScopedTypeVariables #-}{-# LANGUAGE TypeFamilies, ConstraintKinds #-}moduleDevelopment.Shake.Internal.Rules.Oracle(addOracle ,addOracleCache ,addOracleHash ,askOracle ,askOracles )whereimportDevelopment.Shake.Internal.Core.Types importDevelopment.Shake.Internal.Core.Rules importDevelopment.Shake.Internal.Options importDevelopment.Shake.Internal.Core.Build importDevelopment.Shake.Internal.Value importDevelopment.Shake.Classes importqualifiedData.ByteStringasBSimportqualifiedData.ByteString.LazyasLBSimportControl.MonadimportData.BinaryimportGeneral.Binary importGeneral.Extra -- Use short type names, since the names appear in the Haddock, and are too long if they are in fullnewtypeOracleQ question =OracleQ question deriving(Show,Typeable,Eq,Hashable,Binary,NFData)newtypeOracleA answer =OracleA answer deriving(Show,Typeable,Eq,Hashable,Binary,NFData)fromOracleA::OracleA a ->a fromOracleA (OracleA x )=x typeinstanceRuleResult (OracleQ a )=OracleA (RuleResult a )dataFlavor =Norm |Cache |Hash derivingEqaddOracleFlavor::(Located ,RuleResultq ~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 rebuildopts <-getShakeOptionsRules letskip =shakeRebuildApply opts ""==RebuildLater addBuiltinRule noLint (\_v ->Just$runBuilder $putEx $hashv )$\(OracleQ q )old mode ->caseold ofJustold |(flavor /=Hash &&skip )||(flavor ==Cache &&mode ==RunDependenciesSame )->return$RunResult ChangedNothing old $decode' old _->do-- can only use cmpHash if flavor == HashletcmpValue new =iffmapdecode' old ==Justnew thenChangedRecomputeSame elseChangedRecomputeDiff letcmpHash newHash =ifold ==JustnewHash thenChangedRecomputeSame elseChangedRecomputeDiff cache <-ifflavor ==Cache thenhistoryLoad 0elsereturnNothingcasecache ofJustnewEncode ->doletnew =decode' newEncode return$RunResult (cmpValue new )newEncode new Nothing->donew <-OracleA <$>act q letnewHash =encodeHash new letnewEncode =encode' new when(flavor ==Cache )$historySave 0newEncode return$ifflavor ==Hash thenRunResult (cmpHash newHash )newHash new elseRunResult (cmpValue new )newEncode new returnaskOracle whereencodeHash::Hashablea =>a ->BS.ByteStringencodeHash =runBuilder .putEx .hashencode'::Binarya =>a ->BS.ByteStringencode' =BS.concat.LBS.toChunks.encodedecode'::Binarya =>BS.ByteString->a decode' =decode.LBS.fromChunks.return-- | 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 _) -> fmap '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\"-- return [(reverse b, reverse a) | x <- words out, let (a,_:b) = break (== \'-\') $ reverse x]---- getPkgVersion \<- 'addOracle' $ \\(GhcPkgVersion pkg) -> do-- pkgs <- getPkgList $ GhcPkgList ()-- return $ 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::(RuleResultq ~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::(RuleResultq ~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::(RuleResultq ~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::(RuleResultq ~a ,ShakeValue q ,ShakeValue a )=>q ->Action a askOracle =fmapfromOracleA .apply1 .OracleQ -- | A parallel version of 'askOracle'.askOracles::(RuleResultq ~a ,ShakeValue q ,ShakeValue a )=>[q ]->Action [a ]askOracles =fmap(mapfromOracleA ).apply .mapOracleQ