{-# LANGUAGE CPP #-}{-# LANGUAGE RecordWildCards, ScopedTypeVariables #-}{-# LANGUAGE GeneralizedNewtypeDeriving, ConstraintKinds #-}{-# LANGUAGE ExistentialQuantification, RankNTypes #-}{-# LANGUAGE TypeFamilies, DeriveDataTypeable #-}moduleDevelopment.Shake.Internal.Core.Rules(Rules ,runRules ,RuleResult ,addBuiltinRule ,addBuiltinRuleEx ,noLint ,noIdentity ,getShakeOptionsRules ,getUserRuleInternal ,getUserRuleOne ,getUserRuleList ,getUserRuleMaybe ,addUserRule ,alternatives ,priority ,versioned ,getTargets ,addTarget ,withTargetDocs ,withoutTargets ,action ,withoutActions )whereimportControl.ApplicativeimportData.Tuple.ExtraimportControl.ExceptionimportControl.Monad.ExtraimportControl.Monad.FiximportControl.Monad.IO.ClassimportControl.Monad.Trans.ReaderimportDevelopment.Shake.Classes importGeneral.Binary importGeneral.Extra importData.TypeableimportData.DataimportData.List.ExtraimportqualifiedData.HashMap.StrictasMapimportqualifiedGeneral.TypeMap asTMapimportData.MaybeimportData.IORefimportData.Semigroup(Semigroup(..))importqualifiedData.ByteString.LazyasLBSimportqualifiedData.Binary.BuilderasBinimportData.Binary.PutimportData.Binary.GetimportGeneral.ListBuilder #if __GLASGOW_HASKELL__ >= 800
importControl.Monad.Fail#endif
importDevelopment.Shake.Internal.Core.Types importDevelopment.Shake.Internal.Core.Monad importDevelopment.Shake.Internal.Value importDevelopment.Shake.Internal.Options importDevelopment.Shake.Internal.Errors ----------------------------------------------------------------------- RULES-- | Get the 'ShakeOptions' that were used.getShakeOptionsRules::Rules ShakeOptions getShakeOptionsRules =Rules $asksfst-- | 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 cheapergetUserRuleInternal::forallkey a b .(ShakeValue key ,Typeablea )=>key ->(a ->MaybeString)->(a ->Maybeb )->Action (MaybeVer ,[(Int,b )],SomeException)getUserRuleInternal key disp test =doGlobal {..}<-Action getRO letUserRuleVersioned versioned rules =fromMaybemempty$TMap.lookup globalUserRules letver =ifversioned thenNothingelseJust$Ver 0letitems =head$(mapsnd$reverse$groupSort$f (Ver 0)Nothingrules )++[[]]leterr =errorMultipleRulesMatch (typeOfkey )(showkey )(mapsnd3items )return(ver ,map(\(Ver v ,_,x )->(v ,x ))items ,err )wheref::Ver ->MaybeDouble->UserRule a ->[(Double,(Ver ,MaybeString,b ))]f v p (UserRule x )=[(fromMaybe1p ,(v ,disp x ,x2 ))|Justx2 <-[test x ]]fv p (Unordered xs )=concatMap(f v p )xs fv p (Priority p2 x )=f v (Just$fromMaybep2 p )x f_p (Versioned v x )=f v p x fv p (Alternative x )=take1$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::Typeablea =>(a ->Maybeb )->Action [(Int,b )]getUserRuleList test =snd3<$>getUserRuleInternal ()(constNothing)test -- | A version of 'getUserRuleList' that fails if there is more than one result-- Requires a @key@ for better error messages.getUserRuleMaybe::(ShakeValue key ,Typeablea )=>key ->(a ->MaybeString)->(a ->Maybeb )->Action (Maybe(Int,b ))getUserRuleMaybe key disp test =do(_,xs ,err )<-getUserRuleInternal key disp test casexs of[]->returnNothing[x ]->return$Justx _->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 ,Typeablea )=>key ->(a ->MaybeString)->(a ->Maybeb )->Action (Int,b )getUserRuleOne key disp test =do(_,xs ,err )<-getUserRuleInternal key disp test casexs of[x ]->returnx _->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".newtypeRules a =Rules (ReaderT(ShakeOptions ,IORefSRules )IOa )-- All IO must be associative/commutative (e.g. creating IORef/MVars)deriving(Functor,Applicative,Monad,MonadIO,MonadFix#if __GLASGOW_HASKELL__ >= 800
,MonadFail#endif
)newRules::SRules ->Rules ()newRules x =Rules $liftIO.flipmodifyIORef'(<>x )=<<askssndmodifyRulesScoped::(SRules ->SRules )->Rules a ->Rules a modifyRulesScoped f (Rules r )=Rules $do(opts ,refOld )<-askliftIO$dorefNew <-newIORefmemptyres <-runReaderTr (opts ,refNew )rules <-readIORefrefNew modifyIORef'refOld (<>f rules )returnres runRules::ShakeOptions ->Rules ()->IO([(Stack ,Action ())],Map.HashMapTypeRepBuiltinRule ,TMap.Map UserRuleVersioned ,[Target ])runRules opts (Rules r )=doref <-newIORefmemptyrunReaderTr (opts ,ref )SRules {..}<-readIORefref return(runListBuilder actions ,builtinRules ,userRules ,runListBuilder targets )-- | 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,MaybeString)]getTargets opts rs =do(_actions ,_ruleinfo ,_userRules ,targets )<-runRules opts rs return[(target ,documentation )|Target {..}<-targets ]dataTarget =Target {target ::!String,documentation ::!(MaybeString)}deriving(Eq,Ord,Show,Read,Data,Typeable)dataSRules =SRules {actions ::!(ListBuilder (Stack ,Action ())),builtinRules ::!(Map.HashMapTypeRep{-k-}BuiltinRule ),userRules ::!(TMap.Map UserRuleVersioned ),targets ::!(ListBuilder Target )}instanceSemigroupSRules where(SRules x1 x2 x3 x4 )<> (SRules y1 y2 y3 y4 )=SRules (mappendx1 y1 )(Map.unionWithKeyf x2 y2 )(TMap.unionWith (<>)x3 y3 )(mappendx4 y4 )wheref k a b =throwImpure $errorRuleDefinedMultipleTimes k [builtinLocationa ,builtinLocationb ]instanceMonoidSRules wheremempty =SRules memptyMap.emptyTMap.empty memptymappend =(<>)instanceSemigroupa =>Semigroup(Rules a )where(<> )=liftA2(<>)instance(Semigroupa ,Monoida )=>Monoid(Rules a )wheremempty =returnmemptymappend =(<>)-- | 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::Typeablea =>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' prodivde the specified documentation, if they-- don't already have documentation.withTargetDocs::String->Rules ()->Rules ()withTargetDocs d =modifyRulesScoped $\x ->x {targets=f <$>targetsx }wheref (Target a b )=Target a $Just$fromMaybed 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}-- | A suitable 'BuiltinLint' that always succeeds.noLint::BuiltinLint key value noLint __=returnNothing-- | 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::Typeablekey =>BuiltinIdentity key value noIdentity __=Nothing-- | The type mapping between the @key@ or a rule and the resulting @value@.-- See 'addBuiltinRule' and 'apply'.typefamilyRuleResult key -- = value-- | 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.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.addBuiltinRule::(RuleResultkey ~value ,ShakeValue key ,Typeablevalue ,NFDatavalue ,Showvalue ,Partial)=>BuiltinLint key value ->BuiltinIdentity key value ->BuiltinRun key value ->Rules ()addBuiltinRule =withFrozenCallStack$addBuiltinRuleInternal $BinaryOp (putEx .Bin.toLazyByteString.execPut.put)(runGetget.LBS.fromChunks.return)addBuiltinRuleEx::(RuleResultkey ~value ,ShakeValue key ,BinaryEx key ,Typeablevalue ,NFDatavalue ,Showvalue ,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::(RuleResultkey ~value ,ShakeValue key ,Typeablevalue ,NFDatavalue ,Showvalue ,Partial)=>BinaryOp key ->BuiltinLint key value ->BuiltinIdentity key value ->BuiltinRun key value ->Rules ()addBuiltinRuleInternal binary lint check (run ::BuiltinRun key value )=doletk =Proxy::Proxykey letlint_ k v =lint (fromKey k )(fromValue v )letcheck_ k v =check (fromKey k )(fromValue v )letrun_ k v b =fmapnewValue <$>run (fromKey k )v b letbinary_ =BinaryOp (putOpbinary .fromKey )(newKey .getOpbinary )newRules mempty{builtinRules=Map.singleton(typeRepk )$BuiltinRule lint_ check_ run_ binary_ (Ver 0)callStackTop }-- | Change the priority of a given set of rules, where higher priorities 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 )$userRuless }-- | 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 )$userRuless ,builtinRules=Map.map(\b ->b {builtinVersion=Ver v })$builtinRuless }-- | 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 )$userRulesr }-- | 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 ,voidact )}-- | 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}