{-# 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-- @moduleDevelopment.Shake.Database(ShakeDatabase ,shakeOpenDatabase ,shakeWithDatabase ,shakeOneShotDatabase ,shakeRunDatabase ,shakeLiveFilesDatabase ,shakeProfileDatabase ,shakeErrorsDatabase ,shakeRunAfter )whereimportControl.Concurrent.ExtraimportControl.ExceptionimportControl.MonadimportControl.Monad.IO.ClassimportData.IORefimportGeneral.Cleanup importDevelopment.Shake.Internal.Errors importDevelopment.Shake.Internal.Options importDevelopment.Shake.Internal.Core.Rules importDevelopment.Shake.Internal.Core.Run importDevelopment.Shake.Internal.Core.Types importDevelopment.Shake.Internal.Rules.Default dataUseState =Closed |Using String|Open {UseState -> Bool openOneShot ::Bool,UseState -> 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).dataShakeDatabase =ShakeDatabase (VarUseState )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(IOShakeDatabase ,IO())shakeOpenDatabase :: ShakeOptions -> Rules () -> IO (IO ShakeDatabase, IO ()) shakeOpenDatabase ShakeOptions opts Rules () rules =do(Cleanup cleanup ,IO () clean )<-IO (Cleanup, IO ()) newCleanup Var UseState use <-UseState -> IO (Var UseState) forall a. a -> IO (Var a) newVar(UseState -> IO (Var UseState)) -> UseState -> IO (Var UseState) forall a b. (a -> b) -> a -> b $Bool -> Bool -> UseState Open Bool FalseBool Falseletalloc :: IO ShakeDatabase alloc =Var UseState -> String -> (UseState -> UseState) -> (UseState -> IO ShakeDatabase) -> IO ShakeDatabase forall a. Var UseState -> String -> (UseState -> UseState) -> (UseState -> IO a) -> IO a withOpen Var UseState use String "shakeOpenDatabase"UseState -> UseState forall a. a -> a id((UseState -> IO ShakeDatabase) -> IO ShakeDatabase) -> (UseState -> IO ShakeDatabase) -> IO ShakeDatabase forall a b. (a -> b) -> a -> b $\UseState _->Var UseState -> RunState -> ShakeDatabase ShakeDatabase Var UseState use (RunState -> ShakeDatabase) -> IO RunState -> IO ShakeDatabase forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$>Cleanup -> ShakeOptions -> Rules () -> IO RunState open Cleanup cleanup ShakeOptions opts (Rules () rules Rules () -> Rules () -> Rules () forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >>Rules () defaultRules )letfree :: IO () free =doVar UseState -> (UseState -> IO UseState) -> IO () forall a. Var a -> (a -> IO a) -> IO () modifyVar_Var UseState use ((UseState -> IO UseState) -> IO ()) -> (UseState -> IO UseState) -> IO () forall a b. (a -> b) -> a -> b $\caseUsing String s ->SomeException -> IO UseState forall (m :: * -> *) a. MonadIO m => SomeException -> m a throwM (SomeException -> IO UseState) -> SomeException -> IO UseState forall a b. (a -> b) -> a -> b $String -> [(String, Maybe String)] -> String -> SomeException errorStructured String "Error when calling shakeOpenDatabase close function, currently running"[(String "Existing call",String -> Maybe String forall a. a -> Maybe a JustString s )]String ""UseState _->UseState -> IO UseState forall (f :: * -> *) a. Applicative f => a -> f a pureUseState Closed IO () clean (IO ShakeDatabase, IO ()) -> IO (IO ShakeDatabase, IO ()) forall (f :: * -> *) a. Applicative f => a -> f a pure(IO ShakeDatabase alloc ,IO () free )withOpen ::VarUseState ->String->(UseState ->UseState )->(UseState ->IOa )->IOa withOpen :: Var UseState -> String -> (UseState -> UseState) -> (UseState -> IO a) -> IO a withOpen Var UseState var String name UseState -> UseState final UseState -> IO a act =((forall a. IO a -> IO a) -> IO a) -> IO a forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b mask(((forall a. IO a -> IO a) -> IO a) -> IO a) -> ((forall a. IO a -> IO a) -> IO a) -> IO a forall a b. (a -> b) -> a -> b $\forall a. IO a -> IO a restore ->doUseState o <-Var UseState -> (UseState -> IO (UseState, UseState)) -> IO UseState forall a b. Var a -> (a -> IO (a, b)) -> IO b modifyVarVar UseState var ((UseState -> IO (UseState, UseState)) -> IO UseState) -> (UseState -> IO (UseState, UseState)) -> IO UseState forall a b. (a -> b) -> a -> b $\caseUsing String s ->SomeException -> IO (UseState, UseState) forall (m :: * -> *) a. MonadIO m => SomeException -> m a throwM (SomeException -> IO (UseState, UseState)) -> SomeException -> IO (UseState, UseState) forall a b. (a -> b) -> a -> b $String -> [(String, Maybe String)] -> String -> SomeException errorStructured (String "Error when calling "String -> String -> String forall a. [a] -> [a] -> [a] ++String name String -> String -> String forall a. [a] -> [a] -> [a] ++String ", currently running")[(String "Existing call",String -> Maybe String forall a. a -> Maybe a JustString s )]String ""UseState Closed ->SomeException -> IO (UseState, UseState) forall (m :: * -> *) a. MonadIO m => SomeException -> m a throwM (SomeException -> IO (UseState, UseState)) -> SomeException -> IO (UseState, UseState) forall a b. (a -> b) -> a -> b $String -> [(String, Maybe String)] -> String -> SomeException errorStructured (String "Error when calling "String -> String -> String forall a. [a] -> [a] -> [a] ++String name String -> String -> String forall a. [a] -> [a] -> [a] ++String ", already closed")[]String ""o :: UseState o @Open {}->(UseState, UseState) -> IO (UseState, UseState) forall (f :: * -> *) a. Applicative f => a -> f a pure(String -> UseState Using String name ,UseState o )letclean :: IO () clean =Var UseState -> UseState -> IO () forall a. Var a -> a -> IO () writeVarVar UseState var (UseState -> IO ()) -> UseState -> IO () forall a b. (a -> b) -> a -> b $UseState -> UseState final UseState o a res <-IO a -> IO a forall a. IO a -> IO a restore (UseState -> IO a act UseState o )IO a -> IO () -> IO a forall a b. IO a -> IO b -> IO a `onException`IO () clean IO () clean a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a purea 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 -> IO () shakeOneShotDatabase (ShakeDatabase Var UseState use RunState _)=Var UseState -> String -> (UseState -> UseState) -> (UseState -> IO ()) -> IO () forall a. Var UseState -> String -> (UseState -> UseState) -> (UseState -> IO a) -> IO a withOpen Var UseState use String "shakeOneShotDatabase"(\UseState o ->UseState o {openOneShot :: Bool openOneShot =Bool True})((UseState -> IO ()) -> IO ()) -> (UseState -> IO ()) -> IO () forall a b. (a -> b) -> a -> b $\UseState _->() -> IO () forall (f :: * -> *) a. Applicative f => a -> f a pure()-- | Given some options and rules, create a 'ShakeDatabase' that can be used to run-- executions.shakeWithDatabase ::ShakeOptions ->Rules ()->(ShakeDatabase ->IOa )->IOa shakeWithDatabase :: ShakeOptions -> Rules () -> (ShakeDatabase -> IO a) -> IO a shakeWithDatabase ShakeOptions opts Rules () rules ShakeDatabase -> IO a act =do(IO ShakeDatabase db ,IO () clean )<-ShakeOptions -> Rules () -> IO (IO ShakeDatabase, IO ()) shakeOpenDatabase ShakeOptions opts Rules () rules (ShakeDatabase -> IO a act (ShakeDatabase -> IO a) -> IO ShakeDatabase -> IO a forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<<IO ShakeDatabase db )IO a -> IO () -> IO a forall a b. IO a -> IO b -> IO a `finally`IO () 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 -> IO [String] shakeLiveFilesDatabase (ShakeDatabase Var UseState use RunState s )=Var UseState -> String -> (UseState -> UseState) -> (UseState -> IO [String]) -> IO [String] forall a. Var UseState -> String -> (UseState -> UseState) -> (UseState -> IO a) -> IO a withOpen Var UseState use String "shakeLiveFilesDatabase"UseState -> UseState forall a. a -> a id((UseState -> IO [String]) -> IO [String]) -> (UseState -> IO [String]) -> IO [String] forall a b. (a -> b) -> a -> b $\UseState _->RunState -> IO [String] liveFilesState RunState 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 -> String -> IO () shakeProfileDatabase (ShakeDatabase Var UseState use RunState s )String file =Var UseState -> String -> (UseState -> UseState) -> (UseState -> IO ()) -> IO () forall a. Var UseState -> String -> (UseState -> UseState) -> (UseState -> IO a) -> IO a withOpen Var UseState use String "shakeProfileDatabase"UseState -> UseState forall a. a -> a id((UseState -> IO ()) -> IO ()) -> (UseState -> IO ()) -> IO () forall a b. (a -> b) -> a -> b $\UseState _->RunState -> String -> IO () profileState RunState s String 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 possile in one run set @'shakeStaunch'=True@.shakeErrorsDatabase ::ShakeDatabase ->IO[(String,SomeException)]shakeErrorsDatabase :: ShakeDatabase -> IO [(String, SomeException)] shakeErrorsDatabase (ShakeDatabase Var UseState use RunState s )=Var UseState -> String -> (UseState -> UseState) -> (UseState -> IO [(String, SomeException)]) -> IO [(String, SomeException)] forall a. Var UseState -> String -> (UseState -> UseState) -> (UseState -> IO a) -> IO a withOpen Var UseState use String "shakeErrorsDatabase"UseState -> UseState forall a. a -> a id((UseState -> IO [(String, SomeException)]) -> IO [(String, SomeException)]) -> (UseState -> IO [(String, SomeException)]) -> IO [(String, SomeException)] forall a b. (a -> b) -> a -> b $\UseState _->RunState -> IO [(String, SomeException)] errorsState RunState 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 -> [Action a] -> IO ([a], [IO ()]) shakeRunDatabase (ShakeDatabase Var UseState use RunState s )[Action a] as =Var UseState -> String -> (UseState -> UseState) -> (UseState -> IO ([a], [IO ()])) -> IO ([a], [IO ()]) forall a. Var UseState -> String -> (UseState -> UseState) -> (UseState -> IO a) -> IO a withOpen Var UseState use String "shakeRunDatabase"(\UseState o ->UseState o {openRequiresReset :: Bool openRequiresReset =Bool True})((UseState -> IO ([a], [IO ()])) -> IO ([a], [IO ()])) -> (UseState -> IO ([a], [IO ()])) -> IO ([a], [IO ()]) forall a b. (a -> b) -> a -> b $\Open {Bool openRequiresReset :: Bool openOneShot :: Bool openRequiresReset :: UseState -> Bool openOneShot :: UseState -> Bool .. }->doBool -> IO () -> IO () forall (f :: * -> *). Applicative f => Bool -> f () -> f () whenBool openRequiresReset (IO () -> IO ()) -> IO () -> IO () forall a b. (a -> b) -> a -> b $doBool -> IO () -> IO () forall (f :: * -> *). Applicative f => Bool -> f () -> f () whenBool openOneShot (IO () -> IO ()) -> IO () -> IO () forall a b. (a -> b) -> a -> b $SomeException -> IO () forall (m :: * -> *) a. MonadIO m => SomeException -> m a throwM (SomeException -> IO ()) -> SomeException -> IO () forall a b. (a -> b) -> a -> b $String -> [(String, Maybe String)] -> String -> SomeException errorStructured String "Error when calling shakeRunDatabase twice, after calling shakeOneShotDatabase"[]String ""RunState -> IO () reset RunState s ([IORef (Maybe a)] refs ,[Action ()] as )<-([(IORef (Maybe a), Action ())] -> ([IORef (Maybe a)], [Action ()])) -> IO [(IORef (Maybe a), Action ())] -> IO ([IORef (Maybe a)], [Action ()]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap[(IORef (Maybe a), Action ())] -> ([IORef (Maybe a)], [Action ()]) forall a b. [(a, b)] -> ([a], [b]) unzip(IO [(IORef (Maybe a), Action ())] -> IO ([IORef (Maybe a)], [Action ()])) -> IO [(IORef (Maybe a), Action ())] -> IO ([IORef (Maybe a)], [Action ()]) forall a b. (a -> b) -> a -> b $[Action a] -> (Action a -> IO (IORef (Maybe a), Action ())) -> IO [(IORef (Maybe a), Action ())] forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => t a -> (a -> m b) -> m (t b) forM[Action a] as ((Action a -> IO (IORef (Maybe a), Action ())) -> IO [(IORef (Maybe a), Action ())]) -> (Action a -> IO (IORef (Maybe a), Action ())) -> IO [(IORef (Maybe a), Action ())] forall a b. (a -> b) -> a -> b $\Action a a ->doIORef (Maybe a) ref <-Maybe a -> IO (IORef (Maybe a)) forall a. a -> IO (IORef a) newIORefMaybe a forall a. Maybe a Nothing(IORef (Maybe a), Action ()) -> IO (IORef (Maybe a), Action ()) forall (f :: * -> *) a. Applicative f => a -> f a pure(IORef (Maybe a) ref ,IO () -> Action () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO(IO () -> Action ()) -> (a -> IO ()) -> a -> Action () forall b c a. (b -> c) -> (a -> b) -> a -> c .IORef (Maybe a) -> Maybe a -> IO () forall a. IORef a -> a -> IO () writeIORefIORef (Maybe a) ref (Maybe a -> IO ()) -> (a -> Maybe a) -> a -> IO () forall b c a. (b -> c) -> (a -> b) -> a -> c .a -> Maybe a forall a. a -> Maybe a Just(a -> Action ()) -> Action a -> Action () forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<<Action a a )[IO ()] after <-RunState -> Bool -> [Action ()] -> IO [IO ()] run RunState s Bool openOneShot ([Action ()] -> IO [IO ()]) -> [Action ()] -> IO [IO ()] forall a b. (a -> b) -> a -> b $(Action () -> Action ()) -> [Action ()] -> [Action ()] forall a b. (a -> b) -> [a] -> [b] mapAction () -> Action () forall (f :: * -> *) a. Functor f => f a -> f () void[Action ()] as [Maybe a] results <-(IORef (Maybe a) -> IO (Maybe a)) -> [IORef (Maybe a)] -> IO [Maybe a] forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) mapMIORef (Maybe a) -> IO (Maybe a) forall a. IORef a -> IO a readIORef[IORef (Maybe a)] refs case[Maybe a] -> Maybe [a] forall (t :: * -> *) (m :: * -> *) a. (Traversable t, Monad m) => t (m a) -> m (t a) sequence[Maybe a] results ofJust[a] result ->([a], [IO ()]) -> IO ([a], [IO ()]) forall (f :: * -> *) a. Applicative f => a -> f a pure([a] result ,[IO ()] after )Maybe [a] Nothing->SomeException -> IO ([a], [IO ()]) forall (m :: * -> *) a. MonadIO m => SomeException -> m a throwM (SomeException -> IO ([a], [IO ()])) -> SomeException -> IO ([a], [IO ()]) forall a b. (a -> b) -> a -> b $Partial => String -> SomeException String -> SomeException errorInternal String "Expected all results were written, but some where not"